Makes hlint pass

haskell-bitcoin · Sep 30, 2022 · 41a92ea · 41a92ea
1 parent 0293da9
commit 41a92ea
Show file tree

Hide file tree

Showing 7 changed files with 101 additions and 78 deletions.
diff --git a/src/Haskoin/Constants.hs b/src/Haskoin/Constants.hs
@@ -1,6 +1,4 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 {- |

diff --git a/src/Haskoin/Crypto/Hash.hs b/src/Haskoin/Crypto/Hash.hs
@@ -97,23 +97,23 @@ instance Show Hash512 where
 instance Read Hash512 where
     readPrec = do
         R.String str <- lexP
-        maybe pfail return $ Hash512 . BSS.toShort <$> decodeHex (cs str)
+        maybe pfail (return . Hash512 . BSS.toShort) (decodeHex (cs str))
 
 instance Show Hash256 where
     showsPrec _ = shows . encodeHex . BSS.fromShort . getHash256
 
 instance Read Hash256 where
     readPrec = do
         R.String str <- lexP
-        maybe pfail return $ Hash256 . BSS.toShort <$> decodeHex (cs str)
+        maybe pfail (return . Hash256 . BSS.toShort) (decodeHex (cs str))
 
 instance Show Hash160 where
     showsPrec _ = shows . encodeHex . BSS.fromShort . getHash160
 
 instance Read Hash160 where
     readPrec = do
         R.String str <- lexP
-        maybe pfail return $ Hash160 . BSS.toShort <$> decodeHex (cs str)
+        maybe pfail (return . Hash160 . BSS.toShort) (decodeHex (cs str))
 
 instance IsString Hash512 where
     fromString str =

diff --git a/src/Haskoin/Keys/Extended.hs b/src/Haskoin/Keys/Extended.hs
@@ -173,16 +173,16 @@ type KeyIndex = Word32
  parent node and an index to differentiate it from other siblings.
 -}
 data XPrvKey = XPrvKey
-    { -- | depth in the tree
-      xPrvDepth :: !Word8
-    , -- | fingerprint of parent
-      xPrvParent :: !Fingerprint
-    , -- | derivation index
-      xPrvIndex :: !KeyIndex
-    , -- | chain code
-      xPrvChain :: !ChainCode
-    , -- | private key of this node
-      xPrvKey :: !SecKey
+    { xPrvDepth :: !Word8
+    -- ^ depth in the tree
+    , xPrvParent :: !Fingerprint
+    -- ^ fingerprint of parent
+    , xPrvIndex :: !KeyIndex
+    -- ^ derivation index
+    , xPrvChain :: !ChainCode
+    -- ^ chain code
+    , xPrvKey :: !SecKey
+    -- ^ private key of this node
     }
     deriving (Generic, Eq, Show, Read, NFData, Hashable)
 
@@ -194,7 +194,8 @@ instance Serial XPrvKey where
         serialize $ xPrvChain k
         putPadPrvKey $ xPrvKey k
     deserialize =
-        XPrvKey <$> getWord8
+        XPrvKey
+            <$> getWord8
             <*> deserialize
             <*> getWord32be
             <*> deserialize
@@ -224,16 +225,16 @@ xPrvFromJSON net =
 
 -- | Data type representing an extended BIP32 public key.
 data XPubKey = XPubKey
-    { -- | depth in the tree
-      xPubDepth :: !Word8
-    , -- | fingerprint of parent
-      xPubParent :: !Fingerprint
-    , -- | derivation index
-      xPubIndex :: !KeyIndex
-    , -- | chain code
-      xPubChain :: !ChainCode
-    , -- | public key of this node
-      xPubKey :: !PubKey
+    { xPubDepth :: !Word8
+    -- ^ depth in the tree
+    , xPubParent :: !Fingerprint
+    -- ^ fingerprint of parent
+    , xPubIndex :: !KeyIndex
+    -- ^ derivation index
+    , xPubChain :: !ChainCode
+    -- ^ chain code
+    , xPubKey :: !PubKey
+    -- ^ public key of this node
     }
     deriving (Generic, Eq, Show, Read, NFData, Hashable)
 
@@ -245,7 +246,8 @@ instance Serial XPubKey where
         serialize $ xPubChain k
         serialize $ wrapPubKey True (xPubKey k)
     deserialize =
-        XPubKey <$> getWord8
+        XPubKey
+            <$> getWord8
             <*> deserialize
             <*> getWord32be
             <*> deserialize
@@ -804,7 +806,7 @@ instance Read DerivPath where
     readPrec = parens $ do
         R.Ident "DerivPath" <- lexP
         R.String str <- lexP
-        maybe pfail return $ getParsedPath <$> parsePath str
+        maybe pfail (return . getParsedPath) (parsePath str)
 
 instance Show HardPath where
     showsPrec d p =
@@ -961,14 +963,12 @@ instance Read Bip32PathIndex where
             parens $ do
                 R.Ident "Bip32HardIndex" <- lexP
                 R.Number n <- lexP
-                maybe pfail return $
-                    Bip32HardIndex . fromIntegral <$> numberToInteger n
+                maybe pfail (return . Bip32HardIndex . fromIntegral) (numberToInteger n)
         s =
             parens $ do
                 R.Ident "Bip32SoftIndex" <- lexP
                 R.Number n <- lexP
-                maybe pfail return $
-                    Bip32SoftIndex . fromIntegral <$> numberToInteger n
+                maybe pfail (return . Bip32SoftIndex . fromIntegral) (numberToInteger n)
 
 -- | Test whether the number could be a valid BIP32 derivation index.
 is31Bit :: (Integral a) => a -> Bool

diff --git a/src/Haskoin/Transaction/Builder.hs b/src/Haskoin/Transaction/Builder.hs
@@ -315,8 +315,12 @@ guessMSSize (m, n) =
     -- OP_M + n*PubKey + OP_N + OP_CHECKMULTISIG
 
     rdm =
-        fromIntegral $
-            B.length $ runPutS $ serialize $ opPushData $ B.replicate (n * 34 + 3) 0
+        fromIntegral
+            . B.length
+            . runPutS
+            . serialize
+            . opPushData
+            $ B.replicate (n * 34 + 3) 0
     -- Redeem + m*sig + OP_0
     scp = rdm + m * 73 + 1
 
@@ -453,8 +457,10 @@ mergeTxInput net txs tx ((so, val), i) = do
         case out of
             PayMulSig msPubs r ->
                 let sigs =
-                        take r $
-                            catMaybes $ matchTemplate allSigs msPubs $ f out
+                        take r
+                            . catMaybes
+                            . matchTemplate allSigs msPubs
+                            $ f out
                  in return $ RegularInput $ SpendMulSig sigs
             PayScriptHash _ ->
                 case rdmM of
@@ -510,9 +516,10 @@ verifyStdInput net tx i so0 val
 
     nestedScriptOutput :: Either String ScriptOutput
     nestedScriptOutput =
-        scriptOps <$> runGetS deserialize inp >>= \case
-            [OP_PUSHDATA bs _] -> decodeOutputBS bs
-            _ -> Left "nestedScriptOutput: not a nested output"
+        runGetS deserialize inp
+            >>= \case
+                Script [OP_PUSHDATA bs _] -> decodeOutputBS bs
+                _ -> Left "nestedScriptOutput: not a nested output"
 
     verifyLegacyInput :: ScriptOutput -> ScriptInput -> Bool
     verifyLegacyInput so si = case (so, si) of

diff --git a/src/Haskoin/Util/Arbitrary/Block.hs b/src/Haskoin/Util/Arbitrary/Block.hs
@@ -28,7 +28,8 @@ arbitraryBlock net = do
 -- | Block header with random hash.
 arbitraryBlockHeader :: Gen BlockHeader
 arbitraryBlockHeader =
-    BlockHeader <$> arbitrary
+    BlockHeader
+        <$> arbitrary
         <*> arbitraryBlockHash
         <*> arbitraryHash256
         <*> arbitrary
@@ -42,14 +43,16 @@ arbitraryBlockHash = BlockHash <$> arbitraryHash256
 -- | Arbitrary 'GetBlocks' object with at least one block hash.
 arbitraryGetBlocks :: Gen GetBlocks
 arbitraryGetBlocks =
-    GetBlocks <$> arbitrary
+    GetBlocks
+        <$> arbitrary
         <*> listOf1 arbitraryBlockHash
         <*> arbitraryBlockHash
 
 -- | Arbitrary 'GetHeaders' object with at least one block header.
 arbitraryGetHeaders :: Gen GetHeaders
 arbitraryGetHeaders =
-    GetHeaders <$> arbitrary
+    GetHeaders
+        <$> arbitrary
         <*> listOf1 arbitraryBlockHash
         <*> arbitraryBlockHash
 
@@ -71,13 +74,11 @@ arbitraryMerkleBlock = do
 -- | Arbitrary 'BlockNode'
 arbitraryBlockNode :: Gen BlockNode
 arbitraryBlockNode =
-    oneof
-        [ BlockNode
-            <$> arbitraryBlockHeader
-            <*> choose (0, maxBound)
-            <*> arbitrarySizedNatural
-            <*> arbitraryBlockHash
-        ]
+    BlockNode
+        <$> arbitraryBlockHeader
+        <*> choose (0, maxBound)
+        <*> arbitrarySizedNatural
+        <*> arbitraryBlockHash
 
 -- | Arbitrary 'HeaderMemory'
 arbitraryHeaderMemory :: Gen HeaderMemory

diff --git a/test/Haskoin/Address/Bech32Spec.hs b/test/Haskoin/Address/Bech32Spec.hs
@@ -27,32 +27,43 @@ spec = do
         it "should be invalid" $
             forM_ invalidChecksums testInvalidChecksum
         it "should be case-insensitive" $
-            all (== Just "test12hrzfj") $
-                map (flip (bech32Encode Bech32) []) hrpCaseVariants
+            all ((== Just "test12hrzfj") . flip (bech32Encode Bech32) []) hrpCaseVariants
     describe "bech32 address" $ do
         it "should be valid" $
             forM_ validChecksums (uncurry testValidChecksum)
         it "should be invalid" $
             forM_ invalidChecksums testInvalidChecksum
         it "should be case-insensitive" $
-            all (== Just "test12hrzfj") $
-                map (flip (bech32Encode Bech32) []) hrpCaseVariants
+            all ((== Just "test12hrzfj") . flip (bech32Encode Bech32) []) hrpCaseVariants
     describe "bech32 encoding/decoding" $ do
-        it "should not encode long data string" $
-            assert . isNothing $
-                bech32Encode Bech32 "bc" (replicate 82 (word5 (1 :: Word8)))
-        it "should not encode bad version number" $
-            assert $ isNothing $ segwitEncode "bc" 17 []
-        it "should not encode invalid length for version 0" $
-            assert $ isNothing $ segwitEncode "bc" 0 (replicate 30 1)
-        it "should relax length restrictions for versions other than 0" $
-            assert $ isJust $ segwitEncode "bc" 1 (replicate 30 1)
-        it "should not encode another long data string" $
-            assert $ isNothing $ segwitEncode "bc" 1 (replicate 41 1)
-        it "should not encode empty human readable part" $
-            assert $ isNothing $ bech32Encode Bech32 "" []
-        it "should not decode empty human-readable part" $
-            assert $ isNothing $ bech32Decode "10a06t8"
+        it "should not encode long data string"
+            . assert
+            . isNothing
+            $ bech32Encode Bech32 "bc" (replicate 82 (word5 (1 :: Word8)))
+        it "should not encode bad version number"
+            . assert
+            . isNothing
+            $ segwitEncode "bc" 17 []
+        it "should not encode invalid length for version 0"
+            . assert
+            . isNothing
+            $ segwitEncode "bc" 0 (replicate 30 1)
+        it "should relax length restrictions for versions other than 0"
+            . assert
+            . isJust
+            $ segwitEncode "bc" 1 (replicate 30 1)
+        it "should not encode another long data string"
+            . assert
+            . isNothing
+            $ segwitEncode "bc" 1 (replicate 41 1)
+        it "should not encode empty human readable part"
+            . assert
+            . isNothing
+            $ bech32Encode Bech32 "" []
+        it "should not decode empty human-readable part"
+            . assert
+            . isNothing
+            $ bech32Decode "10a06t8"
         it "human-readable part should be case-insensitive" $
             bech32Encode Bech32 "HRP" [] `shouldBe` bech32Encode Bech32 "hrp" []
 

diff --git a/test/Haskoin/TransactionSpec.hs b/test/Haskoin/TransactionSpec.hs
@@ -60,9 +60,11 @@ spec = do
     testIdentity serialVals readVals jsonVals []
     describe "Transaction properties" $ do
         prop "decode and encode txid" $
-            forAll arbitraryTxHash $ \h -> hexToTxHash (txHashToHex h) == Just h
+            forAll arbitraryTxHash $
+                \h -> hexToTxHash (txHashToHex h) == Just h
         prop "from string transaction id" $
-            forAll arbitraryTxHash $ \h -> fromString (cs $ txHashToHex h) == h
+            forAll arbitraryTxHash $
+                \h -> fromString (cs $ txHashToHex h) == h
         prop "building address tx" $
             forAll arbitraryNetwork $ \net ->
                 forAll arbitraryAddress $
@@ -246,7 +248,8 @@ testBuildAddrTx net a (TestCoin v)
     out =
         decodeOutputBS $
             scriptOutput $
-                head $ txOut (fromRight (error "Could not build transaction") tx)
+                head $
+                    txOut (fromRight (error "Could not build transaction") tx)
 
 -- We compute an upper bound but it should be close enough to the real size
 -- We give 2 bytes of slack on every signature (1 on r and 1 on s)
@@ -260,7 +263,8 @@ testGuessSize net tx =
     ins = map f $ txIn tx
     f i =
         fromRight (error "Could not decode input") $
-            decodeInputBS net $ scriptInput i
+            decodeInputBS net $
+                scriptInput i
     pki = length $ filter isSpendPKHash ins
     msi = concatMap shData ins
     shData (ScriptHashInput _ (PayMulSig keys r)) = [(r, length keys)]
@@ -277,8 +281,8 @@ testGuessSize net tx =
 
 testChooseCoins :: [TestCoin] -> Word64 -> Word64 -> Int -> Property
 testChooseCoins coins target byteFee nOut =
-    nOut >= 0
-        ==> case chooseCoins target byteFee nOut True coins of
+    nOut >= 0 ==>
+        case chooseCoins target byteFee nOut True coins of
             Right (chosen, change) ->
                 let outSum = sum $ map coinValue chosen
                     fee = guessTxFee byteFee nOut (length chosen)
@@ -297,8 +301,8 @@ testChooseMSCoins ::
     Int ->
     Property
 testChooseMSCoins (m, n) coins target byteFee nOut =
-    nOut >= 0
-        ==> case chooseMSCoins target byteFee (m, n) nOut True coins of
+    nOut >= 0 ==>
+        case chooseMSCoins target byteFee (m, n) nOut True coins of
             Right (chosen, change) ->
                 let outSum = sum $ map coinValue chosen
                     fee = guessMSTxFee byteFee (m, n) nOut (length chosen)
@@ -360,8 +364,10 @@ testMergeTx net (txs, os) =
     isValid = verifyStdTx net mergedTx outs
     enoughSigs = all (\(m, c) -> c >= m) sigMap
     sigMap =
-        map (\((_, _, _, m, _), inp) -> (m, sigCnt inp)) $
-            zip os $ txIn mergedTx
+        zipWith
+            (\(_, _, _, m, _) inp -> (m, sigCnt inp))
+            os
+            (txIn mergedTx)
     sigCnt inp =
         case decodeInputBS net $ scriptInput inp of
             Right (RegularInput (SpendMulSig sigs)) -> length sigs