module Bitcoin.Misc.Endian where
import Data.Word
import Foreign
import qualified System.IO.Unsafe as Unsafe
data Endian
= LittleEndian
| BigEndian
deriving (Eq,Show)
isLittleEndian :: Endian -> Bool
isLittleEndian e = case e of
LittleEndian -> True
BigEndian -> False
isBigEndian :: Endian -> Bool
isBigEndian e = case e of
LittleEndian -> False
BigEndian -> True
hostEndian :: Endian
hostEndian = Unsafe.unsafePerformIO detectHostEndian
detectHostEndian :: IO Endian
detectHostEndian = do
let be = 0x12345678 :: Word32
le = 0x78563412 :: Word32
ws = [0x12,0x34,0x56,0x78] :: [Word8]
allocaArray 4 $ \p_word8 -> do
pokeArray p_word8 ws
x <- peek (castPtr p_word8 :: Ptr Word32)
if x == le
then return LittleEndian
else if x == be
then return BigEndian
else error "fatal error: cannot detect endianness of host (neither little-endian nor big-endian)"
class HasByteOrder a where
swapByteOrder :: a -> a
toLilEndBytes :: a -> [Word8]
toBigEndBytes :: a -> [Word8]
fromLilEndBytes :: [Word8] -> a
fromBigEndBytes :: [Word8] -> a
toBigEndBytes = reverse . toLilEndBytes
toLilEndBytes = reverse . toBigEndBytes
fromBigEndBytes = fromLilEndBytes . reverse
fromLilEndBytes = fromBigEndBytes . reverse
toMachineBytes :: HasByteOrder a => a -> [Word8]
toMachineBytes = case hostEndian of
LittleEndian -> toLilEndBytes
BigEndian -> toBigEndBytes
fromMachineBytes :: HasByteOrder a => [Word8] -> a
fromMachineBytes = case hostEndian of
LittleEndian -> fromLilEndBytes
BigEndian -> fromBigEndBytes
swapByteOrderToLE :: HasByteOrder a => a -> a
swapByteOrderToLE = case hostEndian of
LittleEndian -> id
BigEndian -> swapByteOrder
swapByteOrderToBE :: HasByteOrder a => a -> a
swapByteOrderToBE = case hostEndian of
LittleEndian -> swapByteOrder
BigEndian -> id
instance HasByteOrder Word16 where
swapByteOrder x = shiftL (x .&. 0x00ff) 8
+ shiftR (x .&. 0xff00) 8
toLilEndBytes x = map fromIntegral [ x , shiftR x 8 ]
toBigEndBytes x = map fromIntegral [ shiftR x 8 , x ]
fromLilEndBytes [a,b] = shiftL (fromIntegral b) 8
+ fromIntegral a
fromBigEndBytes [b,a] = shiftL (fromIntegral b) 8
+ fromIntegral a
instance HasByteOrder Word32 where
swapByteOrder x = shiftL (x .&. 0x000000ff) 24
+ shiftL (x .&. 0x0000ff00) 8
+ shiftR (x .&. 0x00ff0000) 8
+ shiftR (x .&. 0xff000000) 24
toLilEndBytes x = map fromIntegral [ x , shiftR x 8 , shiftR x 16 , shiftR x 24 ]
toBigEndBytes x = map fromIntegral [ shiftR x 24 , shiftR x 16 , shiftR x 8 , x ]
fromLilEndBytes [a,b,c,d] = shiftL (fromIntegral d) 24
+ shiftL (fromIntegral c) 16
+ shiftL (fromIntegral b) 8
+ fromIntegral a
fromBigEndBytes [d,c,b,a] = shiftL (fromIntegral d) 24
+ shiftL (fromIntegral c) 16
+ shiftL (fromIntegral b) 8
+ fromIntegral a
instance HasByteOrder Word64 where
swapByteOrder x = shiftL (x .&. 0x00000000000000ff) 56
+ shiftL (x .&. 0x000000000000ff00) 40
+ shiftL (x .&. 0x0000000000ff0000) 24
+ shiftL (x .&. 0x00000000ff000000) 8
+ shiftR (x .&. 0x000000ff00000000) 8
+ shiftR (x .&. 0x0000ff0000000000) 24
+ shiftR (x .&. 0x00ff000000000000) 40
+ shiftR (x .&. 0xff00000000000000) 56
toLilEndBytes x = map fromIntegral [ x , shiftR x 8 , shiftR x 16 , shiftR x 24 , shiftR x 32 , shiftR x 40 , shiftR x 48 , shiftR x 56 ]
toBigEndBytes x = map fromIntegral [ shiftR x 56 , shiftR x 48 , shiftR x 40 , shiftR x 32 , shiftR x 24 , shiftR x 16 , shiftR x 8 , x ]
fromLilEndBytes [a,b,c,d,e,f,g,h]
= shiftL (fromIntegral h) 56
+ shiftL (fromIntegral g) 48
+ shiftL (fromIntegral f) 40
+ shiftL (fromIntegral e) 32
+ shiftL (fromIntegral d) 24
+ shiftL (fromIntegral c) 16
+ shiftL (fromIntegral b) 8
+ fromIntegral a
fromBigEndBytes [h,g,f,e,d,c,b,a]
= shiftL (fromIntegral h) 56
+ shiftL (fromIntegral g) 48
+ shiftL (fromIntegral f) 40
+ shiftL (fromIntegral e) 32
+ shiftL (fromIntegral d) 24
+ shiftL (fromIntegral c) 16
+ shiftL (fromIntegral b) 8
+ fromIntegral a