Fixed cabal build.

1 files changed, 0 insertions, 412 deletions

diff --git a/src/Network/DatagramServer/Types.hs b/src/Network/DatagramServer/Types.hs
deleted file mode 100644
index 68aa9212..00000000
--- a/src/Network/DatagramServer/Types.hs
+++ /dev/null
@@ -1,412 +0,0 @@
-{-# LANGUAGE ConstraintKinds        #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE DeriveFunctor              #-}
-{-# LANGUAGE DeriveFoldable             #-}
-{-# LANGUAGE DeriveTraversable          #-}
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE FlexibleContexts       #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE RankNTypes             #-}
-{-# LANGUAGE ScopedTypeVariables    #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeFamilies           #-}
-{-# LANGUAGE StandaloneDeriving     #-}
-module Network.DatagramServer.Types
-        ( module Network.DatagramServer.Types
-        , module Network.DatagramServer.Error
-        ) where
-
-import Control.Applicative
-import qualified Text.ParserCombinators.ReadP as RP
-import Data.Word
-import Data.Monoid
-import Data.Hashable
-import Data.String
-import Data.Bits
-import Data.ByteString (ByteString)
-import Data.Kind       (Constraint)
-import Data.Data
-import Data.Default
-import Data.List.Split
-import Data.Ord
-import Data.IP
-import Network.Socket
-import Text.PrettyPrint as PP hiding ((<>))
-import Text.PrettyPrint.HughesPJClass  hiding (($$), (<>))
-import Text.Read        (readMaybe, readEither)
-import Data.Serialize                  as S
-import qualified Data.ByteString.Char8 as Char8
-import qualified Data.ByteString as BS
-import Data.ByteString.Base16          as Base16
-import System.Entropy
-import Network.DatagramServer.Error
-import Data.LargeWord
-import Data.Char
-
-
-class (Eq a, Serialize a, Typeable a, Hashable a, Pretty a)
-    => Address a where
-  toSockAddr   :: a        -> SockAddr
-  fromSockAddr :: SockAddr -> Maybe a
-
-fromAddr :: (Address a, Address b) => a -> Maybe b
-fromAddr = fromSockAddr . toSockAddr
-
--- | Note that port is zeroed.
-instance Address IPv4 where
-  toSockAddr = SockAddrInet 0 . toHostAddress
-  fromSockAddr (SockAddrInet _ h) = Just (fromHostAddress h)
-  fromSockAddr  _                 = Nothing
-
--- | Note that port is zeroed.
-instance Address IPv6 where
-  toSockAddr h = SockAddrInet6 0 0 (toHostAddress6 h) 0
-  fromSockAddr (SockAddrInet6 _ _ h _) = Just (fromHostAddress6 h)
-  fromSockAddr  _                      = Nothing
-
--- | Note that port is zeroed.
-instance Address IP where
-  toSockAddr (IPv4 h) = toSockAddr h
-  toSockAddr (IPv6 h) = toSockAddr h
-  fromSockAddr sa =
-        IPv4 <$> fromSockAddr sa
-    <|> IPv6 <$> fromSockAddr sa
-
-
-
-
-
-newtype ReflectedIP = ReflectedIP SockAddr
-  deriving (Eq, Ord, Show)
-
--- The MessageClass/MessageClassG duality is merely a way to help GHC derive
--- instances without having to cope with the QueryMethod and TransactionID type
--- functions
-type MessageClass msg = MessageClassG (QueryMethod msg) (TransactionID msg)
-data MessageClassG meth tid = Query meth
-                            | Response (Maybe ReflectedIP)
-                            | Error (KError tid)
- deriving (Eq,Ord,Show) --  ,Read, Data: not implemented by SockAddr
-
-
-class Envelope envelope where
-    data TransactionID envelope
-    type QueryMethod envelope
-    data NodeId envelope
-    data QueryExtra envelope
-    data ResponseExtra envelope
-    data PacketDestination envelope
-
-    envelopePayload     :: envelope a -> a
-    envelopeTransaction :: envelope a -> TransactionID envelope
-    envelopeClass       :: envelope a -> MessageClass envelope
-
-    -- | > replyAddress qry addr
-    --
-    --    [ qry ]  received query message
-    --
-    --    [ addr ] SockAddr of query origin
-    --
-    -- Returns: Destination address for reply.
-    makeAddress :: Either (NodeId envelope) (envelope a) -> SockAddr -> PacketDestination envelope
-
-    -- | > buildReply self addr qry response
-    --
-    --    [ self ]     this node's id.
-    --
-    --    [ addr ]     SockAddr of query origin.
-    --
-    --    [ qry ]      received query message.
-    --
-    --    [ response ] response payload.
-    --
-    -- Returns: response message envelope
-    buildReply :: NodeId envelope -> SockAddr -> envelope a -> b -> envelope b
-
-    -- This is a abstract constructor and a design wart.  Since it returns into
-    -- the IO monad, it allows for outside state to be used in creating
-    -- envelopes.
-    buildQuery :: NodeId envelope -> SockAddr -> QueryMethod envelope -> TransactionID envelope -> a -> IO (envelope a)
-
-    uniqueTransactionId :: Int -> IO (TransactionID envelope)
-
-    fromRoutableNode :: QueryExtra envelope -> Bool
-    fromRoutableNode _ = True
-
--- | In Kademlia, the distance metric is XOR and the result is
--- interpreted as an unsigned integer.
-newtype NodeDistance nodeid = NodeDistance nodeid
-  deriving (Eq, Ord)
-
--- | distance(A,B) = |A xor B| Smaller values are closer.
-distance :: Bits nid => nid -> nid -> NodeDistance nid
-distance a b = NodeDistance $ xor a b
-
-instance Serialize nodeid => Show (NodeDistance nodeid) where
-  show (NodeDistance w) = Char8.unpack $ Base16.encode $ S.encode w
-
-instance Serialize nodeid => Pretty (NodeDistance nodeid) where
-  pPrint n = text $ show n
-
-
--- | When 'get'ing an IP it must be 'isolate'd to the appropriate
--- number of bytes since we have no other way of telling which
--- address type we are trying to parse
-instance Serialize IP where
-    put (IPv4 ip) = put ip
-    put (IPv6 ip) = put ip
-
-    get = do
-      n <- remaining
-      case n of
-        4  -> IPv4 <$> get
-        16 -> IPv6 <$> get
-        _ -> fail (show n ++ " is the wrong number of remaining bytes to parse IP")
-
-instance Serialize IPv4 where
-    put = putWord32host    .  toHostAddress
-    get = fromHostAddress <$> getWord32host
-
-instance Serialize IPv6 where
-    put ip = put $ toHostAddress6 ip
-    get = fromHostAddress6 <$> get
-
-instance Pretty IPv4 where
-  pPrint = PP.text . show
-  {-# INLINE pPrint #-}
-
-instance Pretty IPv6 where
-  pPrint = PP.text . show
-  {-# INLINE pPrint #-}
-
-instance Pretty IP where
-  pPrint = PP.text . show
-  {-# INLINE pPrint #-}
-
-instance Hashable IPv4 where
-  hashWithSalt = hashUsing toHostAddress
-  {-# INLINE hashWithSalt #-}
-
-instance Hashable IPv6 where
-  hashWithSalt s a = hashWithSalt s (toHostAddress6 a)
-
-instance Hashable IP where
-  hashWithSalt s (IPv4 h) = hashWithSalt s h
-  hashWithSalt s (IPv6 h) = hashWithSalt s h
-
-
-
-
-
-data NodeAddr a = NodeAddr
-  { nodeHost ::                !a
-  , nodePort :: {-# UNPACK #-} !PortNumber
-  } deriving (Eq, Ord, Typeable, Functor, Foldable, Traversable)
-
-instance Show a => Show (NodeAddr a) where
-  showsPrec i NodeAddr {..}
-    = showsPrec i nodeHost <> showString ":" <> showsPrec i nodePort
-
-instance Read (NodeAddr IPv4) where
-  readsPrec i = RP.readP_to_S $ do
-    ipv4 <- RP.readS_to_P (readsPrec i)
-    _    <- RP.char ':'
-    port <- toEnum <$> RP.readS_to_P (readsPrec i)
-    return $ NodeAddr ipv4 port
-
--- | @127.0.0.1:6882@
-instance Default (NodeAddr IPv4) where
-  def = "127.0.0.1:6882"
-
--- | KRPC compatible encoding.
-instance Serialize a => Serialize (NodeAddr a) where
-  get = NodeAddr <$> get <*> get
-  {-# INLINE get #-}
-  put NodeAddr {..} = put nodeHost >> put nodePort
-  {-# INLINE put #-}
-
--- | Example:
---
---   @nodePort \"127.0.0.1:6881\" == 6881@
---
-instance IsString (NodeAddr IPv4) where
-  fromString str
-    | [hostAddrStr, portStr] <- splitWhen (== ':') str
-    , Just hostAddr <- readMaybe hostAddrStr
-    , Just portNum  <- toEnum <$> readMaybe portStr
-                = NodeAddr hostAddr portNum
-    | otherwise = error $ "fromString: unable to parse (NodeAddr IPv4): " ++ str
-
-instance Hashable PortNumber where
-  hashWithSalt s = hashWithSalt s . fromEnum
-  {-# INLINE hashWithSalt #-}
-
-instance Pretty PortNumber where
-  pPrint = PP.int . fromEnum
-  {-# INLINE pPrint #-}
-
-
-instance Hashable a => Hashable (NodeAddr a) where
-  hashWithSalt s NodeAddr {..} = hashWithSalt s (nodeHost, nodePort)
-  {-# INLINE hashWithSalt #-}
-
-instance Pretty ip => Pretty (NodeAddr ip) where
-  pPrint NodeAddr {..} = pPrint nodeHost <> ":" <> pPrint nodePort
-
-
-instance Serialize PortNumber where
-  get = fromIntegral <$> getWord16be
-  {-# INLINE get #-}
-  put = putWord16be . fromIntegral
-  {-# INLINE put #-}
-
-
-
-
-data NodeInfo dht addr u = NodeInfo
-  { nodeId   :: !(NodeId dht)
-  , nodeAddr :: !(NodeAddr addr)
-  , nodeAnnotation :: u
-  } deriving (Functor, Foldable, Traversable)
-
-deriving instance ( Show (NodeId dht)
-                  , Show addr
-                  , Show u ) => Show (NodeInfo dht addr u)
-
-hexdigit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'f') || ( 'A' <= c && c <= 'F')
-
-instance ( FiniteBits (NodeId dht)
-         , Read (NodeId dht)
-         , Read (NodeAddr addr)
-         , Default u
-         ) => Read (NodeInfo dht addr u) where
-  readsPrec i = RP.readP_to_S $ do
-    RP.skipSpaces
-    let n = finiteBitSize (undefined :: NodeId dht) `div` 4
-    hexhash <- sequence $ replicate n (RP.satisfy hexdigit)
-    RP.char '@' RP.+++ RP.satisfy isSpace
-    addrstr <- RP.between (RP.char '(') (RP.char ')') (RP.munch (/=')'))
-                RP.+++ RP.munch (not . isSpace)
-    addr <- either fail return $ readEither addrstr
-    nid <- either fail return $ readEither hexhash
-    return $ NodeInfo nid addr def
-
-
-
-mapAddress :: (addr -> b) -> NodeInfo dht addr u -> NodeInfo dht b u
-mapAddress f ni = ni { nodeAddr = fmap f (nodeAddr ni) }
-
-traverseAddress :: Applicative f => (addr -> f b) -> NodeInfo dht addr u -> f (NodeInfo dht b u)
-traverseAddress f ni = fmap (\addr -> ni { nodeAddr = addr }) $ traverse f (nodeAddr ni)
-
--- Warning: Eq and Ord only look at the nodeId field.
-instance Eq (NodeId dht) => Eq (NodeInfo dht a u) where
-    a == b  = (nodeId a == nodeId b)
-
-instance Ord (NodeId dht) => Ord (NodeInfo dht a u) where
-  compare = comparing nodeId
-
-
--- TODO WARN is the 'system' random suitable for this?
--- | Generate random NodeID used for the entire session.
---   Distribution of ID's should be as uniform as possible.
---
-genNodeId :: forall dht.
-             ( Serialize (NodeId dht)
-             , FiniteBits (NodeId dht)
-             ) => IO (NodeId dht)
-genNodeId = either error id . S.decode <$> getEntropy nodeIdSize
- where
-    nodeIdSize = finiteBitSize (undefined :: NodeId dht) `div` 8
-
--- | Generate a random 'NodeId' within a range suitable for a bucket.  To
--- obtain a sample for bucket number /index/ where /is_last/ indicates if this
--- is for the current deepest bucket in our routing table:
---
--- > sample <- genBucketSample nid (bucketRange index is_last)
-genBucketSample :: ( FiniteBits nid
-                   , Serialize nid
-                   ) => nid -> (Int,Word8,Word8) -> IO nid
-genBucketSample n qmb = genBucketSample' getEntropy n qmb
-
--- | Generalizion of 'genBucketSample' that accepts a byte generator
--- function to use instead of the system entropy.
-genBucketSample' :: forall m dht nid.
-                    ( Applicative m
-                    , FiniteBits nid
-                    , Serialize nid
-                    ) =>
-    (Int -> m ByteString) -> nid -> (Int,Word8,Word8) -> m nid
-genBucketSample' gen self (q,m,b)
-    | q <= 0           =  either error id . S.decode <$> gen nodeIdSize
-    | q >= nodeIdSize  =  pure self
-    | otherwise        =  either error id . S.decode .  build <$> gen (nodeIdSize - q + 1)
- where
-    nodeIdSize = finiteBitSize (undefined :: nid) `div` 8
-    build tl = BS.init hd <> BS.cons (h .|. t) (BS.tail tl)
-     where
-        hd = BS.take q $ S.encode self
-        h = xor b (complement m .&. BS.last hd)
-        t = m .&. BS.head tl
-
-class (Envelope envelope, Address (PacketDestination envelope)) => WireFormat raw envelope where
-    type SerializableTo raw :: * -> Constraint
-    type CipherContext raw envelope
-
-    parsePacket :: Proxy envelope -> ByteString -> Either String raw
-
-    default parsePacket :: raw ~ ByteString => Proxy envelope -> ByteString -> Either String ByteString
-    parsePacket _ = Right
-
-    buildError :: KError (TransactionID envelope) -> Maybe (envelope raw)
-    buildError _ = Nothing
-
-    decodeHeaders :: CipherContext raw envelope -> raw -> Either String (envelope raw)
-    decodePayload :: SerializableTo raw a => envelope raw -> Either String (envelope a)
-
-    encodeHeaders :: CipherContext raw envelope -> envelope raw -> PacketDestination envelope -> ByteString
-    encodePayload :: SerializableTo raw a => envelope a -> envelope raw
-
-    initializeServerState :: Proxy (envelope raw) -> Maybe (NodeId envelope) -> IO (NodeId envelope, CipherContext raw envelope)
-
-
-encodeHexDoc :: Serialize x => x -> Doc
-encodeHexDoc nid = PP.text $ Char8.unpack $ Base16.encode $ S.encode nid
-
-decodeHex :: Serialize x => String -> [(x,String)]
-decodeHex s = either (const []) (pure . (, Char8.unpack ybs)) $ S.decode xbs
-    where
-        (xbs,ybs) = Base16.decode $ Char8.pack s
-
--- FIXME Orphan Serialize intance for large words
-instance (Serialize a, Serialize b) => Serialize (LargeKey a b) where
-   put (LargeKey lo hi) = put hi >> put lo
-   get = flip LargeKey <$> get <*> get
-
-instance (Pretty ip, Pretty (NodeId dht)) => Pretty (NodeInfo dht ip u) where
-  pPrint NodeInfo {..} = pPrint nodeId <> "@(" <> pPrint nodeAddr <> ")"
-
-instance (Pretty ip, Pretty (NodeId dht)) => Pretty [NodeInfo dht ip u] where
-  pPrint = PP.vcat . PP.punctuate "," . map pPrint
-
-
-
-putSockAddr (SockAddrInet port addr)
-    = put (0x34 :: Word8) >> put port >> put addr
-putSockAddr (SockAddrInet6 port flow addr scope)
-    = put (0x36 :: Word8) >> put port >> put addr >> put scope >> put flow
-putSockAddr (SockAddrUnix path)
-    = put (0x75 :: Word8) >> put path
-putSockAddr (SockAddrCan num)
-    = put (0x63 :: Word8) >> put num
-
-getSockAddr = do
-    c <- get
-    case c :: Word8 of
-        0x34 -> SockAddrInet <$> get <*> get
-        0x36 -> (\p a s f -> SockAddrInet6 p f a s) <$> get <*> get <*> get <*> get
-        0x75 -> SockAddrUnix <$> get
-        0x63 -> SockAddrCan <$> get
-        _ -> fail "getSockAddr"