Apply lintingHEADmaster

8 files changed, 99 insertions, 105 deletions

diff --git a/src/Sodium.hs b/src/Sodium.hs
index eb11bb2..fbc461f 100644
--- a/src/Sodium.hs
+++ b/src/Sodium.hs
@@ -86,7 +86,7 @@ publicKeyToCurve25519 pk = unsafePerformIO $ do
 -- | Convenience function for accessing constant C strings
 constByteStrings :: [ByteString] -> ([CStringLen] -> IO b) -> IO b
 constByteStrings =
-  foldr (\v kk -> \k -> (unsafeUseAsCStringLen v) (\a -> kk (\as -> k (a:as)))) ($ [])
+  foldr (\ v kk k -> unsafeUseAsCStringLen v (\a -> kk (\as -> k (a:as)))) ($ [])
 
 -- | Slightly safer cousin to 'buildUnsafeByteString' that remains in the
 -- 'IO' monad.
@@ -96,4 +96,3 @@ buildUnsafeByteString' n k = do
   bs  <- unsafePackMallocCStringLen (ph, fromIntegral n)
   out <- unsafeUseAsCString bs k
   return (out, bs)
-
diff --git a/src/Ssb/Feed.hs b/src/Ssb/Feed.hs
index ebdd2f4..57547a9 100644
--- a/src/Ssb/Feed.hs
+++ b/src/Ssb/Feed.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE GeneralisedNewtypeDeriving #-}
-
 module Ssb.Feed where
 
 import           Protolude               hiding ( Identity
@@ -220,7 +218,7 @@ withoutSignature buf =
     $ snd
     $ BS.breakSubstring (BS.reverse signaturePattern) (BS.reverse buf)
  where
-  appendToEnd      = \x y -> BS.append y x
+  appendToEnd      = flip BS.append
   signaturePattern = ",\n  \"signature\":"
 
 newVerifiableMessage
@@ -251,9 +249,9 @@ atMayFeed i (Feed _ msgs) = atMay msgs i
 -- verification fails.
 append :: ToJSON a => Feed a -> VerifiableMessage a -> Either Text (Feed a)
 append (Feed id msgs) msg = do
-  if (verify id msg)
-    then (return (Feed id (msgs ++ [msg])))
-    else (error "verification failed")
+  if verify id msg
+    then return (Feed id (msgs ++ [msg]))
+    else error "verification failed"
 
 appendContent :: ToJSON a => Feed a -> a -> IO (Either Text (Feed a))
 appendContent (Feed id msgs) content = do
@@ -290,9 +288,9 @@ signMessage id msg = do
                            msg { signature = Just signature }
       return $ do
           vMsg' <- vMsg
-          if (verify id vMsg')
-            then (return vMsg')
-            else (error "signing failed verification")
+          if verify id vMsg'
+            then return vMsg'
+            else error "signing failed verification"
     Left err -> return $ error err
 
 verify :: ToJSON a => Identity -> VerifiableMessage a -> Bool
diff --git a/src/Ssb/Peer/BoxStream.hs b/src/Ssb/Peer/BoxStream.hs
index d804e56..bb81a12 100644
--- a/src/Ssb/Peer/BoxStream.hs
+++ b/src/Ssb/Peer/BoxStream.hs
@@ -296,12 +296,12 @@ readStream' connState bytes = if BS.length (buffer connState) >= bytes
       else do
         let bodyLength' = bodyLength <$> (buf >>= decryptHeader key' nonce')
         case bodyLength' of
-          Left  err         -> return $ (connState, Left err)
+          Left  err         -> return (connState, Left err)
           Right bodyLength' -> do
-            ePayload <- (withErr errNoBody)
+            ePayload <- withErr errNoBody
               <$> read connState (fromIntegral bodyLength')
             case ePayload of
-              Left err -> return $ (connState, Left err)
+              Left err -> return (connState, Left err)
               Right payload ->
                 case
                     decryptMessage key'
diff --git a/src/Ssb/Peer/RPC.hs b/src/Ssb/Peer/RPC.hs
index 1336b5e..1de70f1 100644
--- a/src/Ssb/Peer/RPC.hs
+++ b/src/Ssb/Peer/RPC.hs
@@ -91,7 +91,7 @@ instance FromJSON ProcedureType where
     "async"   -> return Async
     "source"  -> return Source
     "duplex"  -> return Duplex
-    otherwise -> fail $ "unknown value '" <> toS v <> "'"
+    _         -> fail $ "unknown value '" <> toS v <> "'"
 
 instance ToJSON ProcedureType where
   toJSON Async  = "async"
@@ -323,9 +323,9 @@ instance Default Router
 instance Handler Router where
   endpoints demuxer = Map.keys (endpointHandlers demuxer)
 
-  serve demuxer endpoint = case Map.lookup endpoint endpointHandlers' of
-    Nothing      -> (notFoundHandlerFunc endpoint)
-    Just handler -> handler
+  serve demuxer endpoint = fromMaybe
+    (notFoundHandlerFunc endpoint)
+    (Map.lookup endpoint endpointHandlers')
     where endpointHandlers' = endpointHandlers demuxer
 
   notifyConnect demuxer id = do
@@ -451,7 +451,7 @@ streamStatus :: Stream -> STM StreamStatus
 streamStatus stream = do
   table <- readTMVar $ streamTable stream
   return
-    $ fromMaybe Closed (status . fst <$> Map.lookup (streamID stream) table)
+    $ maybe Closed (status . fst) (Map.lookup (streamID stream) table)
 
 -- | manageStreamConn manages stream connection changes when writing messages
 -- to a stream.
@@ -493,7 +493,7 @@ handleMessage :: Handler h => h -> ConnState -> Message -> IO Bool
 handleMessage handler conn msg = do
   nextReqNum <- atomically $ readTMVar (nextIncomingReqNum conn)
   if
-    | (header msg) == goodByeHeader -> return False
+    | header msg == goodByeHeader -> return False
     | (isRequest nextReqNum msg) -> serveRequest handler conn msg
     | (isEndOfStream msg) -> internalCloseStream conn msg
     | (isAsyncResponse msg) -> do
@@ -503,7 +503,7 @@ handleMessage handler conn msg = do
  where
   internalCloseStream conn msg = do
     let flags          = def { isStream = True, isEndOrError = True }
-    let requestNumber' = (requestNumber . header $ msg)
+    let requestNumber' = requestNumber . header $ msg
     let mVarTable =
           if requestNumber' > 0 then streamsIn conn else streamsOut conn
     table <- atomically $ takeTMVar mVarTable
@@ -554,7 +554,7 @@ handleMessage handler conn msg = do
             then return $ Left errTooManyRequests
             else do
               let (reqNum', table') = if streamID stream == reqNum
-                    then (reqNum + 1, (Map.insert reqNum (stream, chan) table))
+                    then (reqNum + 1, Map.insert reqNum (stream, chan) table)
                     else (reqNum, table)
               putTMVar (nextIncomingReqNum conn) reqNum'
               putTMVar (streamsIn conn)          table'
@@ -566,7 +566,7 @@ handleMessage handler conn msg = do
           Right _ -> do
             -- Serving a request call, how do we close it nicely?
             let endpoint = Endpoint (name req) (typ req)
-            spawnConnection stream $ (serve handler) endpoint (args req) stream
+            spawnConnection stream $ serve handler endpoint (args req) stream
             return True
     where errTooManyRequests = "connection limit reached, dropping request" :: Text
 
@@ -619,7 +619,7 @@ readBoxStream conn bytes = do
 readMessage :: ConnState -> IO (Either Text Message)
 readMessage conn = do
   headerBuf <- readBoxStream (boxConn conn) headerLength
-  header    <- (return $ headerBuf >>= decode)
+  let header = headerBuf >>= decode
   case header of
     Left  err    -> return $ Left $ "RPC.readMessage header: " <> err
     Right header -> do
@@ -627,10 +627,10 @@ readMessage conn = do
       let ret = liftA2 (<>) headerBuf bodyBuf >>= decode
       logDebug conn
         $  "readMessage ("
-        <> (Ssb.formatPublicKey $ connPeer conn)
+        <> Ssb.formatPublicKey (connPeer conn)
         <> ")"
-        <> (show ret)
-      return $ ret
+        <> show ret
+      return ret
  where
   decode :: Serialize a => ByteString -> Either Text a
   decode = mapLeft toS . Serialize.decode
@@ -639,9 +639,9 @@ writeMessage :: ConnState -> Message -> IO (Either Text ())
 writeMessage conn msg = do
   logDebug conn
     $  "writeMessage ("
-    <> (Ssb.formatPublicKey $ connPeer conn)
+    <> Ssb.formatPublicKey (connPeer conn)
     <> ")"
-    <> (show msg)
+    <> show msg
   BoxStream.sendStream (boxConn conn) $ Serialize.encode msg
 
 -- | request makes a Remote Procedure Call on the peer.
@@ -673,7 +673,7 @@ request conn req session = do
           }
 
       let stream = Stream { streamID   = reqNum
-                          , streamType = (typ req)
+                          , streamType = typ req
                           , conn       = conn
                           , direction  = Outgoing
                           , status     = Open
@@ -788,7 +788,7 @@ newCloseErrorNotification streamID msg = do
 closeStreamWithError :: Stream -> Text -> IO (Either Text ())
 closeStreamWithError stream err = case streamType stream of
   Async -> return . return $ ()
-  otherwise ->
+  _ ->
     either (return . Left) (manageStreamConn stream)
       $ newCloseErrorNotification (streamID stream) err
 
@@ -818,7 +818,7 @@ readStreamJSON stream = do
   resp <- readStream stream
   case resp of
     (Just (JSONPayload buf)) -> return (Just <$> decodeJSON buf)
-    (Just otherwise        ) -> return (errPayload resp)
+    (Just _)                 -> return (errPayload resp)
     Nothing                  -> return . return $ Nothing
  where
   errPayload payload =
@@ -834,7 +834,7 @@ writeStream stream flags payload = do
       let msgID = case direction stream of
             Incoming -> -1 * streamID stream
             Outgoing -> streamID stream
-      let flags' = flags { isStream = not $ (streamType stream) == Async }
+      let flags' = flags { isStream = streamType stream /= Async }
       let header' = case payload of
             (BinaryPayload p) ->
               newHeader (flags' { bodyType = Binary }) msgID p
diff --git a/src/Ssb/Peer/RPC/Gossip.hs b/src/Ssb/Peer/RPC/Gossip.hs
index 80e1aac..97eff4c 100644
--- a/src/Ssb/Peer/RPC/Gossip.hs
+++ b/src/Ssb/Peer/RPC/Gossip.hs
@@ -103,7 +103,7 @@ newGossiper = do
     return $ Gossiper mVar
 
 addFeed :: ToJSON a => Gossiper a -> Feed.Feed a -> IO ()
-addFeed (Gossiper (mFeeds)) feed = do
+addFeed (Gossiper mFeeds) feed = do
      atomically $ do
         feeds <- takeTMVar mFeeds
         putTMVar mFeeds (Feed.insert feed feeds)
@@ -115,7 +115,7 @@ writeFeed stream (Feed.Feed _ msgs) = do
     (\msg -> do
       let msg' = Feed.encodeJSONVerifiableMessage msg
       err <- RPC.writeStream stream def (RPC.JSONPayload msg')
-      either (\err -> putStrLn err) (\_ -> return ()) err
+      either putStrLn (\_ -> return ()) err
     )
 
 instance ToJSON a => RPC.Handler (Gossiper a) where
diff --git a/src/Ssb/Peer/RPC/Room.hs b/src/Ssb/Peer/RPC/Room.hs
index 7be7d2c..96c19e8 100644
--- a/src/Ssb/Peer/RPC/Room.hs
+++ b/src/Ssb/Peer/RPC/Room.hs
@@ -287,7 +287,7 @@ instance RPC.Handler Room where
     case args' of
       Left  err       -> return $ Left err
       Right [connReq] -> connect h stream connReq
-      otherwise       -> return $ Left "bad target argument"
+      _               -> return $ Left "bad target argument"
 
   serve h (RPC.Endpoint ["tunnel", "endpoints"] _) _ stream = do
     err <- registerPeer h stream
@@ -304,7 +304,7 @@ instance RPC.Handler Room where
    where
     while f = do
       continue <- f
-      if continue then (while f) else return False
+      if continue then while f else return False
 
   serve room (RPC.Endpoint ["tunnel", "leave"] _) _ stream =
     leave' room (RPC.peer stream)
@@ -317,7 +317,7 @@ instance RPC.Handler Room where
     RPC.writeStreamJSON stream resp
 
   -- HACK: return OK when endpoint not known to avoid disconnecting clients
-  serve room endpoint@otherwise arg stream = return . return $ ()
+  serve room endpoint arg stream = return . return $ ()
   --serve room endpoint@otherwise arg stream = (RPC.notFoundHandlerFunc endpoint) arg stream
 
   notifyConnect _ _ = return . return $ ()
diff --git a/src/Ssb/Peer/SecretHandshake.hs b/src/Ssb/Peer/SecretHandshake.hs
index 4245542..5247a6e 100644
--- a/src/Ssb/Peer/SecretHandshake.hs
+++ b/src/Ssb/Peer/SecretHandshake.hs
@@ -284,16 +284,16 @@ decodeClientAuthMessage state buf = do
         $ SecretBox.secretboxOpen key nonce buf
 
     -- TODO: Make the client auth message length a constant
-    msg3 <- if (BS.length msg3 == 96)
-        then (return msg3)
-        else (Left badMessageLength)
+    msg3 <- if BS.length msg3 == 96
+        then return msg3
+        else Left badMessageLength
     let detachedSignatureA = BS.take 64 msg3
     clientLongTermPubKey   <- naclDecode "client Long Term Public Key"
         $ BS.drop 64 msg3
 
     let msg =
           (network :: ByteString)
-          <> (extractPublicKey serverPublicKey)
+          <> extractPublicKey serverPublicKey
           <> SHA256.hash (Nacl.encode sharedSecretab)
     if Sign.signVerifyDetached
         clientLongTermPubKey
@@ -383,7 +383,7 @@ newDetachedSignatureB network detachedSignatureA clientPublicKey sharedSecretab
     let msg =
           (network :: ByteString)
           <> detachedSignatureA
-          <> (extractPublicKey clientPublicKey)
+          <> extractPublicKey clientPublicKey
           <> SHA256.hash (Nacl.encode sharedSecretab)
     return $ Sign.signDetached key msg
   where
@@ -484,8 +484,7 @@ encode state msg = case msg of
       key <-
           maybeToEither badKeyMsg
           $ Nacl.decode
-          $ SHA256.hash
-          $ ((network :: ByteString)
+          $ SHA256.hash ((network :: ByteString)
           <> Nacl.encode ssab
           <> Nacl.encode ssaB
           <> Nacl.encode ssAb)
@@ -498,71 +497,71 @@ encode state msg = case msg of
 -- TODO: Process secretAb
 process :: ConnState -> Message -> IO (Either Text (ConnState, Maybe Message))
 process state (ClientHello hmac cliEphPubKey network) = do
-  stateUpdate <- return $ do
-    srvLTPrivKey  <- must "server Private Key"
-        $ serverPrivateKey state
-    srvEphPrivKey <- must "server ephemeral Private Key"
-        $ serverEphemeralPrivKey state
-
-    ssab        <- calcSharedSecretab srvEphPrivKey cliEphPubKey
-    -- TODO: srvLTPubKey should be curved Process sk_to_curve25519
-    ssaB        <- serverCalcSharedSecretaB srvLTPrivKey cliEphPubKey
-
-    return $ state { connState             = AwaitingClientAuthentication
-                   , clientEphemeralPubKey = Just cliEphPubKey
-                   , serverHMAC            = Just hmac
-                   , sharedSecretab        = Just ssab
-                   , sharedSecretaB        = Just ssaB
-                   }
+  let stateUpdate = do
+        srvLTPrivKey  <- must "server Private Key"
+            $ serverPrivateKey state
+        srvEphPrivKey <- must "server ephemeral Private Key"
+            $ serverEphemeralPrivKey state
+
+        ssab        <- calcSharedSecretab srvEphPrivKey cliEphPubKey
+        -- TODO: srvLTPubKey should be curved Process sk_to_curve25519
+        ssaB        <- serverCalcSharedSecretaB srvLTPrivKey cliEphPubKey
+
+        return $ state { connState             = AwaitingClientAuthentication
+                       , clientEphemeralPubKey = Just cliEphPubKey
+                       , serverHMAC            = Just hmac
+                       , sharedSecretab        = Just ssab
+                       , sharedSecretaB        = Just ssaB
+                       }
   return $ stateUpdate >>= \state' -> case newServerHello state' of
-    Right msg' -> return $ (state', Just msg')
+    Right msg' -> return (state', Just msg')
     Left  err  -> Left err
 
 process state (ServerHello hmac ephPubKey network) = do
-  stateUpdate <- return $ do
-    cliLTPrivKey  <- must "client Private Key" $ clientPrivateKey state
-    cliEphPrivKey <- must "ephemeral client Private Key"
-      $ clientEphemeralPrivKey state
-    srvLTPubKey <- must "server Public Key" $ serverPublicKey state
-
-    ssab        <- calcSharedSecretab cliEphPrivKey ephPubKey
-    ssaB        <- clientCalcSharedSecretaB cliEphPrivKey srvLTPubKey
-    ssAb        <- calcSharedSecretAb cliLTPrivKey ephPubKey
-
-    return $ state { connState             = AwaitingServerAccept
-                   , serverHMAC            = Just hmac
-                   , serverEphemeralPubKey = Just ephPubKey
-                   , sharedSecretab        = Just ssab
-                   , sharedSecretaB        = Just ssaB
-                   , sharedSecretAb        = Just ssAb
-                   }
+  let stateUpdate = do
+        cliLTPrivKey  <- must "client Private Key" $ clientPrivateKey state
+        cliEphPrivKey <- must "ephemeral client Private Key"
+          $ clientEphemeralPrivKey state
+        srvLTPubKey <- must "server Public Key" $ serverPublicKey state
+
+        ssab        <- calcSharedSecretab cliEphPrivKey ephPubKey
+        ssaB        <- clientCalcSharedSecretaB cliEphPrivKey srvLTPubKey
+        ssAb        <- calcSharedSecretAb cliLTPrivKey ephPubKey
+
+        return $ state { connState             = AwaitingServerAccept
+                       , serverHMAC            = Just hmac
+                       , serverEphemeralPubKey = Just ephPubKey
+                       , sharedSecretab        = Just ssab
+                       , sharedSecretaB        = Just ssaB
+                       , sharedSecretAb        = Just ssAb
+                       }
   return $ stateUpdate >>= \state' -> case newClientAuthMessage state' of
-    Right msg' -> return $ (state', Just msg')
+    Right msg' -> return (state', Just msg')
     Left  err  -> Left err
 
 process state (ClientAuthMessage detachedSignatureA clientLongTermPubKey) = do
-    stateUpdate <- return $ do
-        let network = networkID state
-        srvPrivKey <- must "server private key"
-            $ serverPrivateKey state
-        srvEphPrivKey <- must "server Long Term ephemeral private key"
-            $ serverEphemeralPrivKey state
-        sharedSecretAb <- serverCalcSharedSecretAb srvEphPrivKey clientLongTermPubKey
-        sharedSecretab <- must "shared secret ab" $ sharedSecretab state
-
-        detachedSignatureB <- newDetachedSignatureB
-            network
-            detachedSignatureA
-            clientLongTermPubKey
-            sharedSecretab
-            srvPrivKey
-
-        return $ state { connState          = HandshakeComplete
-                       , detachedSignatureA = Just detachedSignatureA
-                       , detachedSignatureB = Just detachedSignatureB
-                       , clientPublicKey    = Just clientLongTermPubKey
-                       , sharedSecretAb     = Just sharedSecretAb
-                       }
+    let stateUpdate = do
+            let network = networkID state
+            srvPrivKey <- must "server private key"
+                $ serverPrivateKey state
+            srvEphPrivKey <- must "server Long Term ephemeral private key"
+                $ serverEphemeralPrivKey state
+            sharedSecretAb <- serverCalcSharedSecretAb srvEphPrivKey clientLongTermPubKey
+            sharedSecretab <- must "shared secret ab" $ sharedSecretab state
+
+            detachedSignatureB <- newDetachedSignatureB
+                network
+                detachedSignatureA
+                clientLongTermPubKey
+                sharedSecretab
+                srvPrivKey
+
+            return $ state { connState          = HandshakeComplete
+                           , detachedSignatureA = Just detachedSignatureA
+                           , detachedSignatureB = Just detachedSignatureB
+                           , clientPublicKey    = Just clientLongTermPubKey
+                           , sharedSecretAb     = Just sharedSecretAb
+                           }
     return $ stateUpdate >>= \state' -> case newServerAccept state' of
       Right msg' -> return $ (state', Just msg')
       Left  err  -> Left err
@@ -691,5 +690,3 @@ welcomeHandshake send recv network serverID = do
                           case connState state' of
                             HandshakeComplete -> return $ Right state'
                             _                 -> loop state'
-
-
diff --git a/src/Ssb/Peer/TCP.hs b/src/Ssb/Peer/TCP.hs
index 59d7f81..67053bb 100644
--- a/src/Ssb/Peer/TCP.hs
+++ b/src/Ssb/Peer/TCP.hs
@@ -53,7 +53,7 @@ serveBoxStream host port networkID id cmd =
     case res of
         Left err -> putStrLn $ "client handshake error: " <> err
         Right sharedSecrets -> do
-            let peerID = (fromMaybe undefined $ SH.secretA sharedSecrets)
+            let peerID = fromMaybe undefined $ SH.secretA sharedSecrets
             conn <- BoxStream.connectServer socket sharedSecrets
             case conn of
               Left  err  -> putStrLn $ "client error: " <> err