Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix warnings and clean up lint #90

Merged
merged 1 commit into from
Sep 14, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
65 changes: 34 additions & 31 deletions haskell/Codec/FEC.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,22 +31,25 @@ module Codec.FEC (

import Data.Bits (xor)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Unsafe as BU
import Data.List (nub, partition, sortBy, (\\))
import Data.Word (Word8)
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.C.Types (CSize (..), CUInt (..))
import Foreign.ForeignPtr (
ForeignPtr,
newForeignPtr,
withForeignPtr,
)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Array (advancePtr, withArray)
import Foreign.Ptr
import Foreign.Ptr (FunPtr, Ptr, castPtr)
import Foreign.Storable (poke, sizeOf)
import System.IO (IOMode (..), withFile)
import System.IO.Unsafe (unsafePerformIO)

data CFEC
data FECParams = FECParams
{ cfec :: (ForeignPtr CFEC)
{ _cfec :: ForeignPtr CFEC
, paramK :: Int
, paramN :: Int
}
Expand Down Expand Up @@ -111,17 +114,17 @@ fec k n =
else
unsafePerformIO
( do
cfec <- _new (fromIntegral k) (fromIntegral n)
params <- newForeignPtr _free cfec
cfec' <- _new (fromIntegral k) (fromIntegral n)
params <- newForeignPtr _free cfec'
return $ FECParams params k n
)

-- | Create a C array of unsigned from an input array
uintCArray :: [Int] -> ((Ptr CUInt) -> IO a) -> IO a
uintCArray xs f = withArray (map fromIntegral xs) f
uintCArray :: [Int] -> (Ptr CUInt -> IO a) -> IO a
uintCArray = withArray . map fromIntegral

-- | Convert a list of ByteStrings to an array of pointers to their data
byteStringsToArray :: [B.ByteString] -> ((Ptr (Ptr Word8)) -> IO a) -> IO a
byteStringsToArray :: [B.ByteString] -> (Ptr (Ptr Word8) -> IO a) -> IO a
byteStringsToArray inputs f = do
let l = length inputs
allocaBytes
Expand All @@ -141,7 +144,7 @@ byteStringsToArray inputs f = do
-- | Return True iff all the given ByteStrings are the same length
allByteStringsSameLength :: [B.ByteString] -> Bool
allByteStringsSameLength [] = True
allByteStringsSameLength (bs : bss) = all ((==) (B.length bs)) $ map B.length bss
allByteStringsSameLength (bs : bss) = all ((==) (B.length bs) . B.length) bss

{- | Run the given function with a pointer to an array of @n@ pointers to
buffers of size @size@. Return these buffers as a list of ByteStrings
Expand All @@ -151,7 +154,7 @@ createByteStringArray ::
Int ->
-- | the size of each buffer
Int ->
((Ptr (Ptr Word8)) -> IO ()) ->
(Ptr (Ptr Word8) -> IO ()) ->
IO [B.ByteString]
createByteStringArray n size f = do
allocaBytes
Expand Down Expand Up @@ -185,7 +188,7 @@ encode (FECParams params k n) inblocks
let sz = B.length $ head inblocks
withForeignPtr
params
( \cfec -> do
( \cfec' -> do
byteStringsToArray
inblocks
( \src -> do
Expand All @@ -196,7 +199,7 @@ encode (FECParams params k n) inblocks
uintCArray
[k .. (n - 1)]
( \block_nums -> do
_encode cfec src fecs block_nums (fromIntegral (n - k)) $ fromIntegral sz
_encode cfec' src fecs block_nums (fromIntegral (n - k)) $ fromIntegral sz
)
)
)
Expand All @@ -214,12 +217,12 @@ reorderPrimaryBlocks :: Int -> [(Int, a)] -> [(Int, a)]
reorderPrimaryBlocks n blocks = inner (sortTagged pBlocks) sBlocks []
where
(pBlocks, sBlocks) = partition (\(tag, _) -> tag < n) blocks
inner [] sBlocks acc = acc ++ sBlocks
inner pBlocks [] acc = acc ++ pBlocks
inner pBlocks@((tag, a) : ps) sBlocks@(s : ss) acc =
inner [] sBlocks' acc = acc ++ sBlocks'
inner pBlocks' [] acc = acc ++ pBlocks'
inner pBlocks'@((tag, a) : ps) sBlocks'@(s : ss) acc =
if length acc == tag
then inner ps sBlocks (acc ++ [(tag, a)])
else inner pBlocks ss (acc ++ [s])
then inner ps sBlocks' (acc ++ [(tag, a)])
else inner pBlocks' ss (acc ++ [s])

{- | Recover the primary blocks from a list of @k@ blocks. Each block must be
tagged with its number (see the module comments about block numbering)
Expand All @@ -231,8 +234,8 @@ decode ::
-- | a list the @k@ primary blocks
[B.ByteString]
decode (FECParams params k n) inblocks
| length (nub $ map fst inblocks) /= length (inblocks) = error "Duplicate input blocks in FEC decode"
| any (\f -> f < 0 || f >= n) $ map fst inblocks = error "Invalid block numbers in FEC decode"
| length (nub $ map fst inblocks) /= length inblocks = error "Duplicate input blocks in FEC decode"
| any ((\f -> f < 0 || f >= n) . fst) inblocks = error "Invalid block numbers in FEC decode"
| length inblocks /= k = error "Wrong number of blocks to FEC decode"
| not (allByteStringsSameLength $ map snd inblocks) = error "Not all inputs to FEC decode are same length"
| otherwise =
Expand All @@ -243,7 +246,7 @@ decode (FECParams params k n) inblocks
presentBlocks = map fst inblocks'
withForeignPtr
params
( \cfec -> do
( \cfec' -> do
byteStringsToArray
(map snd inblocks')
( \src -> do
Expand All @@ -255,7 +258,7 @@ decode (FECParams params k n) inblocks
uintCArray
presentBlocks
( \block_nums -> do
_decode cfec src out block_nums $ fromIntegral sz
_decode cfec' src out block_nums $ fromIntegral sz
)
)
let blocks = [0 .. (n - 1)] \\ presentBlocks
Expand Down Expand Up @@ -291,10 +294,10 @@ secureDivide n input
ReadMode
( \handle -> do
let inner 1 bs = return [bs]
inner n bs = do
inner n' bs = do
mask <- B.hGet handle (B.length bs)
let masked = B.pack $ B.zipWith xor bs mask
rest <- inner (n - 1) masked
rest <- inner (n' - 1) masked
return (mask : rest)
inner n input
)
Expand Down Expand Up @@ -323,14 +326,14 @@ enFEC ::
[B.ByteString]
enFEC k n input = taggedPrimaryBlocks ++ taggedSecondaryBlocks
where
taggedPrimaryBlocks = map (uncurry B.cons) $ zip [0 ..] primaryBlocks
taggedSecondaryBlocks = map (uncurry B.cons) $ zip [(fromIntegral k) ..] secondaryBlocks
taggedPrimaryBlocks = zipWith B.cons [0 ..] primaryBlocks
taggedSecondaryBlocks = zipWith B.cons [(fromIntegral k) ..] secondaryBlocks
remainder = B.length input `mod` k
paddingLength = if remainder >= 1 then (k - remainder) else k
paddingBytes = (B.replicate (paddingLength - 1) 0) `B.append` (B.singleton $ fromIntegral paddingLength)
paddingLength = if remainder >= 1 then k - remainder else k
paddingBytes = B.replicate (paddingLength - 1) 0 `B.append` B.singleton (fromIntegral paddingLength)
divide a bs
| B.null bs = []
| otherwise = (B.take a bs) : (divide a $ B.drop a bs)
| otherwise = B.take a bs : divide a (B.drop a bs)
input' = input `B.append` paddingBytes
blockSize = B.length input' `div` k
primaryBlocks = divide blockSize input'
Expand Down
84 changes: 44 additions & 40 deletions haskell/test/FECTest.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,20 +2,26 @@

module Main where

import Test.Hspec
import Test.Hspec (describe, hspec, it, parallel)

import qualified Codec.FEC as FEC
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Int
import Data.Int ()
import Data.List (sortOn)
import Data.Serializer
import Data.Word

import System.IO (IOMode (..), withFile)
import System.Random
import Test.QuickCheck
import Test.QuickCheck.Monadic
import Data.Serializer ()
import Data.Word (Word16, Word8)

import System.Random (Random (randoms), mkStdGen)
import Test.QuickCheck (
Arbitrary (arbitrary),
Property,
Testable (property),
choose,
once,
withMaxSuccess,
(===),
)
import Test.QuickCheck.Monadic (assert, monadicIO, run)

-- Imported for the orphan Arbitrary ByteString instance.
import Test.QuickCheck.Instances.ByteString ()
Expand All @@ -29,15 +35,9 @@ data Params = Params

-- | A somewhat efficient generator for valid ZFEC parameters.
instance Arbitrary Params where
arbitrary = do
required <- choose (1, 255)
total <- choose (required, 255)
return $ Params required total

instance Arbitrary FEC.FECParams where
arbitrary = do
(Params required total) <- arbitrary :: Gen Params
return $ FEC.fec required total
arbitrary =
choose (1, 255)
>>= \req -> Params req <$> choose (req, 255)

randomTake :: Int -> Int -> [a] -> [a]
randomTake seed n values = map snd $ take n sortedValues
Expand Down Expand Up @@ -89,30 +89,34 @@ prop_divide size byte divisor = monadicIO $ do
assert (FEC.secureCombine parts == input)

-- | @FEC.encode@ is the inverse of @FEC.decode@.
prop_decode :: FEC.FECParams -> Word16 -> Int -> Property
prop_decode fec len seed = property $ testFEC fec len seed
prop_decode :: Params -> Word16 -> Int -> Property
prop_decode (Params req tot) len seed = property $ do
testFEC fec len seed === True
where
fec = FEC.fec req tot

-- | @FEC.enFEC@ is the inverse of @FEC.deFEC@.
prop_deFEC :: Params -> B.ByteString -> Property
prop_deFEC (Params required total) testdata =
FEC.deFEC required total minimalShares === testdata
prop_deFEC (Params req tot) testdata =
FEC.deFEC req tot minimalShares === testdata
where
allShares = FEC.enFEC required total testdata
minimalShares = take required allShares
allShares = FEC.enFEC req tot testdata
minimalShares = take req allShares

main :: IO ()
main = hspec $ do
describe "secureCombine" $ do
-- secureDivide is insanely slow and memory hungry for large inputs,
-- like QuickCheck will find with it as currently defined. Just pass
-- some small inputs. It's not clear it's worth fixing (or even
-- keeping) thesefunctions. They don't seem to be used by anything.
-- Why are they here?
it "is the inverse of secureDivide n" $ once $ prop_divide 1024 65 3

describe "deFEC" $ do
it "is the inverse of enFEC" $ (withMaxSuccess 2000 prop_deFEC)

describe "decode" $ do
it "is (nearly) the inverse of encode" $ (withMaxSuccess 2000 prop_decode)
it "works with required=255" $ property $ prop_decode (FEC.fec 255 255)
main = hspec $
parallel $ do
describe "secureCombine" $ do
-- secureDivide is insanely slow and memory hungry for large inputs,
-- like QuickCheck will find with it as currently defined. Just pass
-- some small inputs. It's not clear it's worth fixing (or even
-- keeping) thesefunctions. They don't seem to be used by anything.
-- Why are they here?
it "is the inverse of secureDivide n" $ once $ prop_divide 1024 65 3

describe "deFEC" $ do
it "is the inverse of enFEC" (withMaxSuccess 2000 prop_deFEC)

describe "decode" $ do
it "is (nearly) the inverse of encode" (withMaxSuccess 2000 prop_decode)
it "works with required=255" $ property $ prop_decode (Params 255 255)
Loading