commit bb1f4552d73638e59579dc14be3c881162303a57 Author: David Kaloper david@numm.org Date: Wed Sep 4 05:37:53 2013 +0200

-funbox-strict-fields --- src/TorDNSEL/DNS/Internals.hs | 94 +++++++++++++------------- src/TorDNSEL/DNS/Server/Internals.hs | 6 +- src/TorDNSEL/Directory/Internals.hs | 24 +++---- src/TorDNSEL/Document.hs | 10 +-- src/TorDNSEL/NetworkState/Storage/Internals.hs | 8 +-- src/TorDNSEL/NetworkState/Types.hs | 16 ++--- src/TorDNSEL/Socks/Internals.hs | 14 ++-- src/TorDNSEL/Statistics/Internals.hs | 2 +- src/TorDNSEL/TorControl/Internals.hs | 20 +++--- tordnsel.cabal | 2 +- 10 files changed, 98 insertions(+), 98 deletions(-)

diff --git a/src/TorDNSEL/DNS/Internals.hs b/src/TorDNSEL/DNS/Internals.hs index b80b170..0eed2be 100644 --- a/src/TorDNSEL/DNS/Internals.hs +++ b/src/TorDNSEL/DNS/Internals.hs @@ -178,8 +178,8 @@ unsafeDecodeMessage pkt = runGet (getPacket pkt) (L.fromChunks [unPacket pkt]) -- | A value representing the current name compression targets and current -- offset (in bytes) into the datagram we're serializing. data PutState = PutState - { psTargets :: {-# UNPACK #-} !TargetMap - , psCurOff :: {-# UNPACK #-} !Offset } + { psTargets :: !TargetMap + , psCurOff :: !Offset }

-- | The initial state before we start writing a datagram. initialPutState :: PutState @@ -213,7 +213,7 @@ type Offset = Int -- | A tree of labels used as compression targets. The top level represents -- top-level domain names, the second level second-level and so on. Making this -- a newtype triggers a bug in GHC 6.6. -data TargetMap = TargetMap {-# UNPACK #-} !(Map Label (Offset, TargetMap)) +data TargetMap = TargetMap !(Map Label (Offset, TargetMap)) deriving Show

-- | The empty target map. @@ -265,33 +265,33 @@ compressNameStatefully name = do -- | A DNS message containing the header, question, and possibly answers. data Message = Message { -- | A message identifier set by the originator. - msgID :: {-# UNPACK #-} !Word16, + msgID :: !Word16, -- | Is this message a response? - msgQR :: {-# UNPACK #-} !Bool, + msgQR :: !Bool, -- | The kind of query in this message. - msgOpCode :: {-# UNPACK #-} !OpCode, + msgOpCode :: !OpCode, -- | Is the name server an authority for this domain name? - msgAA :: {-# UNPACK #-} !Bool, + msgAA :: !Bool, -- | Is this a truncated response? - msgTC :: {-# UNPACK #-} !Bool, + msgTC :: !Bool, -- | Does the originator desire the query to be pursued recursively? - msgRD :: {-# UNPACK #-} !Bool, + msgRD :: !Bool, -- | Does the name server support recursive queries? - msgRA :: {-# UNPACK #-} !Bool, + msgRA :: !Bool, -- | Has the data in this response been verified by the name server? - msgAD :: {-# UNPACK #-} !Bool, + msgAD :: !Bool, -- | Is non-verified data acceptable to the resolver sending this query? - msgCD :: {-# UNPACK #-} !Bool, + msgCD :: !Bool, -- | Response code set by the name server. - msgRCode :: {-# UNPACK #-} !RCode, + msgRCode :: !RCode, -- | The first question set by the originator. - msgQuestion :: {-# UNPACK #-} !Question, + msgQuestion :: !Question, -- | Answers to the question set by the name server. - msgAnswers :: {-# UNPACK #-} ![ResourceRecord], + msgAnswers :: ![ResourceRecord], -- | Authority records set by the name server. - msgAuthority :: {-# UNPACK #-} ![ResourceRecord], + msgAuthority :: ![ResourceRecord], -- | Additional records set by the name server. - msgAdditional :: {-# UNPACK #-} ![ResourceRecord] } + msgAdditional :: ![ResourceRecord] } deriving (Eq, Show)

instance NFData Message where @@ -357,11 +357,11 @@ instance BinaryPacket Message where -- | A question to the name server. data Question = Question { -- | The domain name this question is about. - qName :: {-# UNPACK #-} !DomainName, + qName :: !DomainName, -- | The type of this question. We only support 'A' and *. - qType :: {-# UNPACK #-} !Type, + qType :: !Type, -- | The class of this question. We only support 'IN'. - qClass :: {-# UNPACK #-} !Class } + qClass :: !Class } deriving (Eq, Show)

instance NFData Question where @@ -382,57 +382,57 @@ data ResourceRecord -- | A record containing an IPv4 address. = A { -- | The domain name to which this record pertains. - rrName :: {-# UNPACK #-} !DomainName, + rrName :: !DomainName, -- | A time interval, in seconds, that the answer may be cached. - rrTTL :: {-# UNPACK #-} !Word32, + rrTTL :: !Word32, -- | An IPv4 address. - aAddr :: {-# UNPACK #-} !HostAddress } + aAddr :: !HostAddress }

-- | An authoritative name server record. | NS { -- | The domain name to which this record pertains. - rrName :: {-# UNPACK #-} !DomainName, + rrName :: !DomainName, -- | A time interval, in seconds, that the answer may be cached. - rrTTL :: {-# UNPACK #-} !Word32, + rrTTL :: !Word32, -- | The host that should be authoritative for this zone. - nsDName :: {-# UNPACK #-} !DomainName } + nsDName :: !DomainName }

-- | A start of zone of authority record. | SOA { -- | The domain name to which this record pertains. - rrName :: {-# UNPACK #-} !DomainName, + rrName :: !DomainName, -- | A time interval, in seconds, that the answer may be cached. - rrTTL :: {-# UNPACK #-} !Word32, + rrTTL :: !Word32, -- | The name server that was the original source of data for this zone. - soaMName :: {-# UNPACK #-} !DomainName, + soaMName :: !DomainName, -- | A name specifying the email address of the person responsible for -- this zone. - soaRName :: {-# UNPACK #-} !DomainName, + soaRName :: !DomainName, -- | The version number of the original copy of this zone. - soaSerial :: {-# UNPACK #-} !Word32, + soaSerial :: !Word32, -- | The number of seconds before the zone should be refreshed. - soaRefresh :: {-# UNPACK #-} !Word32, + soaRefresh :: !Word32, -- | The number of seconds before a failed refresh should be retried. - soaRetry :: {-# UNPACK #-} !Word32, + soaRetry :: !Word32, -- | The number of seconds that can elapse before the zone is no longer -- authoritative. - soaExpire :: {-# UNPACK #-} !Word32, + soaExpire :: !Word32, -- | The default TTL of records that do not contain a TTL, and the TTL of -- negative responses. - soaMinimum :: {-# UNPACK #-} !Word32 } + soaMinimum :: !Word32 }

-- | An unsupported record. | UnsupportedResourceRecord { -- | The domain name to which this record pertains. - rrName :: {-# UNPACK #-} !DomainName, + rrName :: !DomainName, -- | A time interval, in seconds, that the answer may be cached. - rrTTL :: {-# UNPACK #-} !Word32, + rrTTL :: !Word32, -- | The 'Type' of this record. - rrType :: {-# UNPACK #-} !Type, + rrType :: !Type, -- | The 'Class' of this record. - rrClass :: {-# UNPACK #-} !Class, + rrClass :: !Class, -- | An opaque 'ByteString' containing the resource data. - rrData :: {-# UNPACK #-} !ByteString } + rrData :: !ByteString } deriving (Eq, Show)

instance NFData ResourceRecord where @@ -581,11 +581,11 @@ instance NFData OpCode where -- | The TYPE or QTYPE values that appear in resource records or questions, -- respectively. data Type - = TA -- ^ An IPv4 host address. - | TNS -- ^ An authoritative name server. - | TSOA -- ^ A start of zone of authority. - | TAny -- ^ A request for all records. - | UnsupportedType {-# UNPACK #-} !Word16 -- ^ Any other type. + = TA -- ^ An IPv4 host address. + | TNS -- ^ An authoritative name server. + | TSOA -- ^ A start of zone of authority. + | TAny -- ^ A request for all records. + | UnsupportedType !Word16 -- ^ Any other type. deriving (Eq, Show)

instance NFData Type where @@ -609,8 +609,8 @@ instance Binary Type where -- | The CLASS or QCLASS values that appear in resource records or questions, -- respectively. data Class - = IN -- ^ The Internet. We only support this class. - | UnsupportedClass {-# UNPACK #-} !Word16 -- ^ Any other class. + = IN -- ^ The Internet. We only support this class. + | UnsupportedClass !Word16 -- ^ Any other class. deriving (Eq, Show) -- XXX support *

diff --git a/src/TorDNSEL/DNS/Server/Internals.hs b/src/TorDNSEL/DNS/Server/Internals.hs index 8ab3637..268ca8d 100644 --- a/src/TorDNSEL/DNS/Server/Internals.hs +++ b/src/TorDNSEL/DNS/Server/Internals.hs @@ -218,11 +218,11 @@ data ExitListQuery -- https://gitweb.torproject.org/tordnsel.git/tree/doc/torel-design.txt = IPPort { -- | The address of the candidate exit node. - queryAddr :: {-# UNPACK #-} !HostAddress, + queryAddr :: !HostAddress, -- | The destination address. - destAddr :: {-# UNPACK #-} !HostAddress, + destAddr :: !HostAddress, -- | The destination port. - destPort :: {-# UNPACK #-} !Port + destPort :: !Port } deriving Eq

instance Show ExitListQuery where diff --git a/src/TorDNSEL/Directory/Internals.hs b/src/TorDNSEL/Directory/Internals.hs index 154b30c..d7f8303 100644 --- a/src/TorDNSEL/Directory/Internals.hs +++ b/src/TorDNSEL/Directory/Internals.hs @@ -78,13 +78,13 @@ import TorDNSEL.Util -- | A router descriptor. data Descriptor = Desc { -- | The IPv4 address at which this router accepts connections. - descListenAddr :: {-# UNPACK #-} !HostAddress, + descListenAddr :: !HostAddress, -- | The time when this descriptor was generated. - descPublished :: {-# UNPACK #-} !POSIXTime, + descPublished :: !POSIXTime, -- | This router's identifier. - descRouterID :: {-# UNPACK #-} !RouterID, + descRouterID :: !RouterID, -- | This router's exit policy. - descExitPolicy :: {-# UNPACK #-} !ExitPolicy } + descExitPolicy :: !ExitPolicy }

instance Show Descriptor where showsPrec _ d = cat (descRouterID d) ' ' (inet_htoa $ descListenAddr d) ' ' @@ -124,11 +124,11 @@ parseDescriptors = parseSubDocs (B.pack "router") parseDescriptor -- | A router status entry. data RouterStatus = RS { -- | This router's identifier. - rsRouterID :: {-# UNPACK #-} !RouterID, + rsRouterID :: !RouterID, -- | When this router's most recent descriptor was published. - rsPublished :: {-# UNPACK #-} !UTCTime, + rsPublished :: !UTCTime, -- | Is this router running? - rsIsRunning :: {-# UNPACK #-} !Bool } + rsIsRunning :: !Bool } deriving Show

-- | Parse a router status entry. Return the result or 'throwError' in the @@ -226,15 +226,15 @@ instance Hash ExitPolicy where -- port range pattern. data Rule = Rule { -- | Whether an exit connection is allowed. - ruleType :: {-# UNPACK #-} !RuleType, + ruleType :: !RuleType, -- | The IPv4 address part of the pattern. - ruleAddress :: {-# UNPACK #-} !HostAddress, + ruleAddress :: !HostAddress, -- | The IPv4 address mask part of the pattern. - ruleMask :: {-# UNPACK #-} !HostAddress, + ruleMask :: !HostAddress, -- | The first port in the pattern's port range. - ruleBeginPort :: {-# UNPACK #-} !Port, + ruleBeginPort :: !Port, -- | The last port in the pattern's port range. - ruleEndPort :: {-# UNPACK #-} !Port + ruleEndPort :: !Port } deriving (Eq, Ord)

instance Show Rule where diff --git a/src/TorDNSEL/Document.hs b/src/TorDNSEL/Document.hs index 50c986c..f4285c1 100644 --- a/src/TorDNSEL/Document.hs +++ b/src/TorDNSEL/Document.hs @@ -41,15 +41,15 @@ type Document = [Item] -- | An item consisting of a keyword, possibly arguments, and zero or more -- objects. data Item = Item - { iKey :: {-# UNPACK #-} !ByteString -- ^ Keyword - , iArg :: {-# UNPACK #-} !(Maybe ByteString) -- ^ Arguments - , iObj :: {-# UNPACK #-} ![Object] -- ^ Objects + { iKey :: !ByteString -- ^ Keyword + , iArg :: !(Maybe ByteString) -- ^ Arguments + , iObj :: ![Object] -- ^ Objects } deriving Show

-- | An object consisting of a keyword and a block of base64-encoded data. data Object = Object - { objKey :: {-# UNPACK #-} !ByteString -- ^ Keyword - , objData :: {-# UNPACK #-} !ByteString -- ^ Base64-encoded data + { objKey :: !ByteString -- ^ Keyword + , objData :: !ByteString -- ^ Base64-encoded data } deriving Show

-- | Parse a 'Document' from a list of lines. diff --git a/src/TorDNSEL/NetworkState/Storage/Internals.hs b/src/TorDNSEL/NetworkState/Storage/Internals.hs index 79481f6..0f79cf8 100644 --- a/src/TorDNSEL/NetworkState/Storage/Internals.hs +++ b/src/TorDNSEL/NetworkState/Storage/Internals.hs @@ -185,15 +185,15 @@ terminateStorageManager mbWait (StorageManager tellStorageManager tid) = -- same as Tor uses for storing router descriptors. data ExitAddress = ExitAddress { -- | The identity of the exit node we tested through. - eaRouterID :: {-# UNPACK #-} !RouterID, + eaRouterID :: !RouterID, -- | The current descriptor published time when the test was initiated. We -- don't perform another test until a newer descriptor arrives. - eaPublished :: {-# UNPACK #-} !UTCTime, + eaPublished :: !UTCTime, -- | When we last received a network status update for this router. This -- helps us decide when to discard a router. - eaLastStatus :: {-# UNPACK #-} !UTCTime, + eaLastStatus :: !UTCTime, -- | A map from exit address to when the address was last seen. - eaAddresses :: {-# UNPACK #-} !(Map HostAddress UTCTime) + eaAddresses :: !(Map HostAddress UTCTime) } deriving Eq

instance Show ExitAddress where diff --git a/src/TorDNSEL/NetworkState/Types.hs b/src/TorDNSEL/NetworkState/Types.hs index 547ab85..25e809e 100644 --- a/src/TorDNSEL/NetworkState/Types.hs +++ b/src/TorDNSEL/NetworkState/Types.hs @@ -24,27 +24,27 @@ import TorDNSEL.Directory -- | A Tor router. data Router = Router { -- | This router's descriptor, if we have it yet. - rtrDescriptor :: {-# UNPACK #-} !(Maybe Descriptor), + rtrDescriptor :: !(Maybe Descriptor), -- | This router's exit test results, if one has been completed. - rtrTestResults :: {-# UNPACK #-} !(Maybe TestResults), + rtrTestResults :: !(Maybe TestResults), -- | Whether we think this router is running. - rtrIsRunning :: {-# UNPACK #-} !Bool, + rtrIsRunning :: !Bool, -- | The last time we received a router status entry for this router. - rtrLastStatus :: {-# UNPACK #-} !UTCTime } + rtrLastStatus :: !UTCTime }

-- | The results of exit tests. data TestResults = TestResults { -- | The descriptor's published time when the last exit test was initiated. - tstPublished :: {-# UNPACK #-} !UTCTime, + tstPublished :: !UTCTime, -- | A map from exit address to when the address was last seen. - tstAddresses :: {-# UNPACK #-} !(Map HostAddress UTCTime) } + tstAddresses :: !(Map HostAddress UTCTime) }

-- | Our current view of the Tor network. data NetworkState = NetworkState { -- | A map from listen address to routers. - nsAddrs :: {-# UNPACK #-} !(Map HostAddress (Set RouterID)), + nsAddrs :: !(Map HostAddress (Set RouterID)), -- | All the routers we know about. - nsRouters :: {-# UNPACK #-} !(Map RouterID Router) } + nsRouters :: !(Map RouterID Router) }

-- | The empty network state. emptyNetworkState :: NetworkState diff --git a/src/TorDNSEL/Socks/Internals.hs b/src/TorDNSEL/Socks/Internals.hs index f514c44..c5ce474 100644 --- a/src/TorDNSEL/Socks/Internals.hs +++ b/src/TorDNSEL/Socks/Internals.hs @@ -78,11 +78,11 @@ withSocksConnection handle addr port io = (`E.finally` hClose handle) $ do -- | A Socks4a request. data Request = Request { -- | The Socks4 command code (with Tor extensions). - soCommand :: {-# UNPACK #-} !Command, + soCommand :: !Command, -- | The requested destination: either an IPv4 address or a domain name. - soReqDest :: {-# UNPACK #-} !Address, + soReqDest :: !Address, -- | The requested destination port. - soReqPort :: {-# UNPACK #-} !Port } + soReqPort :: !Port }

-- A Socks4a command (with Tor extensions). data Command @@ -92,9 +92,9 @@ data Command

-- | A Socks4 response. data Response = Response - { soResult :: {-# UNPACK #-} !Result -- ^ The result code. - , soRespAddr :: {-# UNPACK #-} !HostAddress -- ^ The destination address. - , soRespPort :: {-# UNPACK #-} !Port -- ^ The destination port. + { soResult :: !Result -- ^ The result code. + , soRespAddr :: !HostAddress -- ^ The destination address. + , soRespPort :: !Port -- ^ The destination port. }

instance NFData Response where @@ -166,7 +166,7 @@ decodeResponse resp = do

-- | A Socks error. data SocksError - = SocksError {-# UNPACK #-} !Result -- ^ A known Socks error code. + = SocksError !Result -- ^ A known Socks error code. | SocksProtocolError -- ^ The response doesn't follow the Socks protocol. deriving Typeable

diff --git a/src/TorDNSEL/Statistics/Internals.hs b/src/TorDNSEL/Statistics/Internals.hs index cc0f799..bb390eb 100644 --- a/src/TorDNSEL/Statistics/Internals.hs +++ b/src/TorDNSEL/Statistics/Internals.hs @@ -42,7 +42,7 @@ import TorDNSEL.Util -- sent. data Stats = Stats { bytesRecv, bytesSent, dgramsRecv, positives - , negatives, others :: {-# UNPACK #-} !Integer } + , negatives, others :: !Integer }

-- | The current statistics state. statsState :: MVar Stats diff --git a/src/TorDNSEL/TorControl/Internals.hs b/src/TorDNSEL/TorControl/Internals.hs index 2ea2e16..95fbbd0 100644 --- a/src/TorDNSEL/TorControl/Internals.hs +++ b/src/TorDNSEL/TorControl/Internals.hs @@ -256,21 +256,21 @@ protocolInfo (Conn _ _ protInfo _) = protInfo -- | A command to send to Tor. data Command = Command { -- | A command keyword. - comKey :: {-# UNPACK #-} !ByteString, + comKey :: !ByteString, -- | Command arguments. - comArgs :: {-# UNPACK #-} ![ByteString], + comArgs :: ![ByteString], -- | A list of lines sent in the data section. - comData :: {-# UNPACK #-} ![ByteString] + comData :: ![ByteString] } deriving Show

-- | A reply sent by Tor in response to a command. data Reply = Reply { -- | A reply code. - repCode :: {-# UNPACK #-} !(Char, Char, Char) + repCode :: !(Char, Char, Char) -- | Reply text. - , repText :: {-# UNPACK #-} !ByteString + , repText :: !ByteString -- | A list of lines from the data section. - , repData :: {-# UNPACK #-} ![ByteString] + , repData :: ![ByteString] } deriving Show

-- | Authenticate with Tor. Throw a 'TorControlError' if authenticating fails @@ -652,8 +652,8 @@ boolVar var = ConfVar getc (setc setConf') (setc resetConf') where

-- | An asynchronous event handler. data EventHandler = EventHandler - { evCode :: {-# UNPACK #-} !ByteString -- ^ The event code. - , evHandler :: {-# UNPACK #-} !([Reply] -> IO ()) -- ^ The event handler. + { evCode :: !ByteString -- ^ The event code. + , evHandler :: !([Reply] -> IO ()) -- ^ The event handler. }

-- | Register a set of handlers for asynchronous events. This deregisters any @@ -828,8 +828,8 @@ startIOManager handle = do

-- | Reply types in a single sequence of replies. data ReplyType - = MidReply {-# UNPACK #-} !Reply -- ^ A reply preceding other replies. - | LastReply {-# UNPACK #-} !Reply -- ^ The last reply. + = MidReply !Reply -- ^ A reply preceding other replies. + | LastReply !Reply -- ^ The last reply. deriving Show

-- | Start a thread that reads replies from @handle@ and passes them to diff --git a/tordnsel.cabal b/tordnsel.cabal index 4f0b11f..3173943 100644 --- a/tordnsel.cabal +++ b/tordnsel.cabal @@ -59,7 +59,7 @@ Other-Modules: TorDNSEL.Config HS-Source-Dirs: src Includes: sys/types.h, unistd.h, sysexits.h, netinet/in.h, openssl/rand.h Extra-Libraries: crypto -GHC-Options: -O2 -Wall -Werror +GHC-Options: -O2 -funbox-strict-fields -Wall -Werror CPP-Options: -DVERSION="0.1.1-dev" Extensions: FlexibleContexts FlexibleInstances