{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Blockchain.ExtWord
  ( Word128
  , Word160
  , Word256
  , Word512
  , word64ToBytes
  , bytesToWord64
  , word128ToBytes
  , bytesToWord128
  , word160ToBytes
  , bytesToWord160
  , word256ToBytes
  , bytesToWord256
  ) where

import Data.Binary
import Data.Bits
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Legacy.Haskoin.V0102.Network.Haskoin.Crypto.BigWord
       (Word128, Word160, Word256, Word512)

import Data.Ix

import Blockchain.Data.RLP

instance Ix Word256 where
  range (x, y)
    | x == y = [x]
  range (x, y) = x : range (x + 1, y)
  index (x, y) z
    | z < x || z > y =
      error $
      "Ix{Word256}.index: Index (" ++
      show z ++ ") out of range ((" ++ show x ++ "," ++ show y ++ "))"
  index (x, _) z = fromIntegral $ z - x
  inRange (x, y) z
    | z >= x && z <= y = True
  inRange _ _ = False

instance RLPSerializable Word512 where
  rlpEncode val = RLPString $ BL.toStrict $ encode val
  rlpDecode (RLPString s)
    | B.length s == 64 = decode $ BL.fromStrict s
  rlpDecode x = error ("Missing case in rlp2Word512: " ++ show x)

word64ToBytes :: Word64 -> [Word8]
word64ToBytes word = map (fromIntegral . (word `shiftR`)) [64 - 8,64 - 16 .. 0]

bytesToWord64 :: [Word8] -> Word64
bytesToWord64 bytes
  | length bytes == 8 =
    sum $
    map (\(shiftBits, byte) -> fromIntegral byte `shiftL` shiftBits) $
    zip [64 - 8,64 - 16 .. 0] bytes
bytesToWord64 _ =
  error "bytesToWord64 was called with the wrong number of bytes"

word128ToBytes :: Word128 -> [Word8]
word128ToBytes word =
  map (fromIntegral . (word `shiftR`)) [128 - 8,128 - 16 .. 0]

bytesToWord128 :: [Word8] -> Word128
bytesToWord128 bytes
  | length bytes == 16 =
    sum $
    map (\(shiftBits, byte) -> fromIntegral byte `shiftL` shiftBits) $
    zip [128 - 8,128 - 16 .. 0] bytes
bytesToWord128 _ =
  error "bytesToWord128 was called with the wrong number of bytes"

word160ToBytes :: Word160 -> [Word8]
word160ToBytes word =
  map (fromIntegral . (word `shiftR`)) [160 - 8,160 - 16 .. 0]

bytesToWord160 :: [Word8] -> Word160
bytesToWord160 bytes
  | length bytes == 20 =
    sum $
    map (\(shiftBits, byte) -> fromIntegral byte `shiftL` shiftBits) $
    zip [160 - 8,160 - 16 .. 0] bytes
bytesToWord160 _ =
  error "bytesToWord128 was called with the wrong number of bytes"

word256ToBytes :: Word256 -> [Word8]
word256ToBytes word =
  map (fromIntegral . (word `shiftR`)) [256 - 8,256 - 16 .. 0]

instance RLPSerializable Word128 where
  rlpEncode val = RLPString $ BL.toStrict $ encode val
  rlpDecode (RLPString s)
    | B.null s = 0
  rlpDecode (RLPString s)
    | B.length s <= 16 = decode $ BL.fromStrict s
  rlpDecode x = error ("Missing case in rlp2Word128: " ++ show x)

instance RLPSerializable Word32 where
  rlpEncode val = RLPString $ BL.toStrict $ encode val
  rlpDecode (RLPString s)
    | B.null s = 0
  rlpDecode (RLPString s)
    | B.length s <= 4 = decode $ BL.fromStrict s
  rlpDecode x = error ("Missing case in rlp2Word32: " ++ show x)

instance RLPSerializable Word16 where
  rlpEncode val = RLPString $ BL.toStrict $ encode val
  rlpDecode (RLPString s)
    | B.null s = 0
  rlpDecode (RLPString s)
    | B.length s <= 2 = decode $ BL.fromStrict s
  rlpDecode x = error ("Missing case in rlp2Word16: " ++ show x)

bytesToWord256 :: [Word8] -> Word256
bytesToWord256 bytes
  | length bytes == 32 =
    sum $
    map (\(shiftBits, byte) -> fromIntegral byte `shiftL` shiftBits) $
    zip [256 - 8,256 - 16 .. 0] bytes
bytesToWord256 _ =
  error "bytesToWord256 was called with the wrong number of bytes"