content: --    Copyright (c) 2011-16, Nicola Bonelli
  --    All rights reserved.
  --
  --    Redistribution and use in source and binary forms, with or without
  --    modification, are permitted provided that the following conditions are met:
  --
  --    * Redistributions of source code must retain the above copyright notice,
  --      this list of conditions and the following disclaimer.
  --    * Redistributions in binary form must reproduce the above copyright
  --      notice, this list of conditions and the following disclaimer in the
  --      documentation and/or other materials provided with the distribution.
  --    * Neither the name of University of Pisa nor the names of its contributors
  --      may be used to endorse or promote products derived from this software
  --      without specific prior written permission.
  --
  --    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
  --    AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  --    IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  --    ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
  --    LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  --    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  --    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
  --    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
  --    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
  --    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  --    POSSIBILITY OF SUCH DAMAGE.
  --
  --
  
  {-# LANGUAGE ImpredicativeTypes #-}
  
  module Network.PFQ.Lang.Experimental
      (
          -- * Experimental Functions
          -- | This set of experimental functions may be subject to changes in future releases
  
        dummy_int
      , dummy_ints
      , dummy_ip
      , dummy_ips
      , dummy_string
      , dummy_strings
      , dummy_cidr
      , dummy_cidrs
  
      , steer_gtp_usr
      , steer_key
  
      , gtp
      , gtp_cp
      , gtp_up
      , is_gtp
      , is_gtp_cp
      , is_gtp_up
      , shift
      , src
      , dst
      , trace
  
      , kernel_if
      , detour_if
  
      , is_broadcast
      , is_multicast
      , is_ip_broadcast
      , is_ip_multicast
      , is_ip_host
      , is_incoming_host
  
      , mac_broadcast
      , mac_multicast
      , incoming_host
      , ip_broadcast
      , ip_multicast
      , ip_host
  
      , is_eth_pup
      , is_eth_sprite
      , is_eth_ip
      , is_eth_arp
      , is_eth_revarp
      , is_eth_at
      , is_eth_aarp
      , is_eth_vlan
      , is_eth_ipx
      , is_eth_ipv6
      , is_eth_loopback
      ) where
  
  
  import Network.PFQ
  import Network.PFQ.Lang
  
  import Data.Word
  
  -- Experimental/Testing in-kernel computations
  
  dummy_int :: Int -> NetFunction
  dummy_int n = Function "dummy_int" n () () () () () () ()
  
  dummy_ints :: [Int] -> NetFunction
  dummy_ints xs  = Function "dummy_ints" xs () () () () () () ()
  
  dummy_ip  :: IPv4 -> NetFunction
  dummy_ip x  = Function "dummy_ip" x () () () () () () ()
  
  dummy_ips  :: [IPv4] -> NetFunction
  dummy_ips xs  = Function "dummy_ips" xs () () () () () () ()
  
  dummy_string :: String -> NetFunction
  dummy_string xs  = Function "dummy_string" xs () () () () () () ()
  
  dummy_strings :: [String] -> NetFunction
  dummy_strings xs  = Function "dummy_strings" xs () () () () () () ()
  
  dummy_cidr  :: CIDR -> NetFunction
  dummy_cidr x  = Function "dummy_cidr" x () () () () () () ()
  
  dummy_cidrs  :: [CIDR] -> NetFunction
  dummy_cidrs xs  = Function "dummy_cidrs" xs () () () () () () ()
  
  
  -- | Dispatch the packet across the sockets
  -- with a randomized algorithm that guarantees
  -- per-user flows consistency on top of GTP tunnel protocol (Control-Plane packets
  -- are broadcasted to all sockets).
  --
  -- > (steer_gtp_usr "192.168.0.0" 16)
  
  steer_gtp_usr :: IPv4 -> Int -> NetFunction
  steer_gtp_usr net prefix = Function "steer_gtp_usr" net prefix () () () () () () :: NetFunction
  
  
  -- | Dispatch the packet to a given socket with id.
  --
  -- > ip >-> steer_key key_5tuple
  
  steer_key :: FlowKey -> NetFunction
  steer_key key = Function "steer_key" (getFlowKey key) () () () () () () () :: NetFunction
  
  
  -- | Evaluate to /Pass Qbuff/ in case of GTP packet, /Drop/ it otherwise.
  gtp    = Function "gtp" () () () () () () () () :: NetFunction
  
  -- | Evaluate to /Pass Qbuff/ in case of GTP Control-Plane packet, /Drop/ it otherwise.
  gtp_cp  = Function "gtp_cp" () () () () () () () () :: NetFunction
  
  -- | Evaluate to /Pass Qbuff/ in case of GTP User-Plane packet, /Drop/ it otherwise.
  gtp_up  = Function "gtp_up" () () () () () () () () :: NetFunction
  
  -- | Evaluate to /True/ if the Qbuff is a GTP packet.
  is_gtp = Predicate "is_gtp" () () () () () () () () :: NetPredicate
  
  -- | Evaluate to /True/ if the Qbuff is a GTP Control-Plane packet.
  is_gtp_cp = Predicate "is_gtp_cp" () () () () () () () () :: NetPredicate
  
  -- | Evaluate to /True/ if the Qbuff is a GTP User-Plane packet.
  is_gtp_up = Predicate "is_gtp_up" () () () () () () () () :: NetPredicate
  
  
  -- The function shift an action...
  --
  -- > shift steer_flow
  shift :: NetFunction -> NetFunction
  shift f = Function "shift" f () () () () () () ()
  
  -- This function creates a 'source' context...
  --
  -- > src $ ...
  src :: NetFunction -> NetFunction
  src f = Function "src" f () () () () () () ()
  
  
  -- The function creates a 'destination' context...
  --
  -- > dst  $ ...
  dst :: NetFunction -> NetFunction
  dst f = Function "dst" f () () () () () () ()
  
  
  -- | Log monadic/state information to syslog.
  --
  -- > udp >-> log_msg "This is an UDP packet"
  --
  trace :: NetFunction
  trace = Function "trace" () () () () () () () ()
  
  
  -- | Conditional forwarder to kernel. Evaluate to /Pass Qbuff/.
  --
  -- > kernel_if is_tcp
  
  kernel_if :: NetPredicate -> NetFunction
  kernel_if p = Function "kernel_if" p () () () () () () ()
  
  -- | Conditional forwarder to kernel. Evaluate to /Drop/ if
  -- predicate evaluates to True, /Pass/ otherwise.
  --
  -- > detour_if is_tcp
  
  detour_if :: NetPredicate -> NetFunction
  detour_if p = Function "detour_if" p () () () () () () ()
  
  -- | Evaluate to /True/ if the Qbuff is broadcast frame.
  is_broadcast = Predicate "is_broadcast" () () () () () () () ()
  
  -- | Evaluate to /True/ if the Qbuff is multicast frame.
  is_multicast = Predicate "is_multicast" () () () () () () () ()
  
  -- | Evaluate to /True/ if the Qbuff is broadcast IP packet.
  is_ip_broadcast = Predicate "is_ip_broadcast" () () () () () () () ()
  
  -- | Evaluate to /True/ if the Qbuff is multicast IP packet.
  is_ip_multicast = Predicate "is_ip_multicast" () () () () () () () ()
  
  -- | Evaluate to /True/ if the Qbuff IP address matches that of the incoming interface,
  -- /False/ otherwise.
  is_ip_host = Predicate "is_ip_host" () () () () () () () ()
  
  -- | Evaluate to /True/ if the Qbuff IP address matches that of the incoming interface,
  --   is a broadcast or a multicast frame.
  is_incoming_host = Predicate "is_incoming_host" () () () () () () () ()
  
  
  -- | Evaluate to /Pass Qbuff/ if it is a broadcast frame, /Drop/ it otherwise.
  mac_broadcast = Function "mac_broadcast" () () () () () () () () :: NetFunction
  
  -- | Evaluate to /Pass Qbuff/ if it is a multicast frame, /Drop/ it otherwise.
  mac_multicast = Function "mac_multicast" () () () () () () () () :: NetFunction
  
  -- | Evaluate to /Pass Qbuff/ if it is a broadcast IP packet, /Drop/ it otherwise.
  ip_broadcast = Function "ip_broadcast" () () () () () () () () :: NetFunction
  
  -- | Evaluate to /Pass Qbuff/ if it is a multicast IP packet, /Drop/ it otherwise.
  ip_multicast = Function "ip_multicast" () () () () () () () () :: NetFunction
  
  -- | Evaluate to /Pass Qbuff/ if the IP address matches that of the incoming interface, /Drop/ it otherwise.
  ip_host = Function "ip_host" () () () () () () () () :: NetFunction
  
  -- | Evaluate to /Pass Qbuff/ if the IP address matches that of the incoming interface,
  -- is a broadcast or a multicast frame, /Drop/ it otherwise.
  incoming_host = Function "incoming_host" () () () () () () () () :: NetFunction
  
  
  -- | Ethernet protocols
  
  is_eth_pup      = Predicate "is_l3_proto" (0x0200 :: Word16)  () () () () () () ()
  is_eth_sprite   = Predicate "is_l3_proto" (0x0500 :: Word16)  () () () () () () ()
  is_eth_ip       = Predicate "is_l3_proto" (0x0800 :: Word16)  () () () () () () ()
  is_eth_arp      = Predicate "is_l3_proto" (0x0806 :: Word16)  () () () () () () ()
  is_eth_revarp   = Predicate "is_l3_proto" (0x8035 :: Word16)  () () () () () () ()
  is_eth_at       = Predicate "is_l3_proto" (0x809B :: Word16)  () () () () () () ()
  is_eth_aarp     = Predicate "is_l3_proto" (0x80F3 :: Word16)  () () () () () () ()
  is_eth_vlan     = Predicate "is_l3_proto" (0x8100 :: Word16)  () () () () () () ()
  is_eth_ipx      = Predicate "is_l3_proto" (0x8137 :: Word16)  () () () () () () ()
  is_eth_ipv6     = Predicate "is_l3_proto" (0x86dd :: Word16)  () () () () () () ()
  is_eth_loopback = Predicate "is_l3_proto" (0x9000 :: Word16)  () () () () () () ()
  
  