[commit: packages/binary] master: Fail rather than throw exception when decoding Bool and Ordering (2991402)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/binary

On branch  : master
Link       : http://git.haskell.org/packages/binary.git/commitdiff/29914028303d553f01deb5313491abebfa7f5a32

>---------------------------------------------------------------

commit 29914028303d553f01deb5313491abebfa7f5a32
Author: Lennart Kolmodin <kolmodin at gmail.com>
Date:   Sun Mar 6 14:54:29 2016 +0100

    Fail rather than throw exception when decoding Bool and Ordering
    
    Decoding Bool and Ordering was not graceful in case of invalid input.
    Trying to decode (2 :: Word8) to a Bool would throw an exception
    in GHC.Enum.toEnum as only the values 0 and 1 are defined.
    
    We work around that in this patch by not using toEnum. In case
    of unexpected input, we fail using 'fail'.
    
    This fixes #108.


>---------------------------------------------------------------

29914028303d553f01deb5313491abebfa7f5a32
 src/Data/Binary/Class.hs | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/src/Data/Binary/Class.hs b/src/Data/Binary/Class.hs
index 0eecfcb..2e8c239 100644
--- a/src/Data/Binary/Class.hs
+++ b/src/Data/Binary/Class.hs
@@ -177,12 +177,21 @@ instance Binary () where
 -- Bools are encoded as a byte in the range 0 .. 1
 instance Binary Bool where
     put     = putWord8 . fromIntegral . fromEnum
-    get     = liftM (toEnum . fromIntegral) getWord8
+    get     = getWord8 >>= toBool
+      where
+        toBool 0 = return False
+        toBool 1 = return True
+        toBool c = fail ("Could not map value " ++ show c ++ " to Bool")
 
 -- Values of type 'Ordering' are encoded as a byte in the range 0 .. 2
 instance Binary Ordering where
     put     = putWord8 . fromIntegral . fromEnum
-    get     = liftM (toEnum . fromIntegral) getWord8
+    get     = getWord8 >>= toOrd
+      where
+        toOrd 0 = return LT
+        toOrd 1 = return EQ
+        toOrd 2 = return GT
+        toOrd c = fail ("Could not map value " ++ show c ++ " to Ordering")
 
 ------------------------------------------------------------------------
 -- Words and Ints