{-# LANGUAGE FlexibleInstances, EmptyDataDecls, ScopedTypeVariables #-}

module Network.EasyBitcoin.Internal.Words 
 where


import Network.EasyBitcoin.Internal.CurveConstants(curveP,curveN)
import Network.EasyBitcoin.Internal.ByteString
import Numeric
import Control.Arrow
import Control.Applicative
import Data.Ratio                      (numerator, denominator)
import Data.Bits                       (shiftR   , shiftL, Bits(..))
import Data.Binary(Binary(..))
import qualified Data.ByteString as BS
import Control.Monad
import Data.Binary.Get ( getWord64be
                       , getWord32be
                       , getWord8
                       , getByteString
                       , Get
                       )
import Data.Binary.Put( putWord64be
                      , putWord32be
                      , putWord8
                      , putByteString
                      )

--import Network.Haskoin.Util

-- | Type representing a transaction hash.
type TxHash = BigWord Mod256Tx


-- | Type representing a block hash.
type BlockHash = BigWord Mod256Block


-- | Data type representing a 512 bit unsigned integer.
-- It is implemented as an Integer modulo 2^512.
type Word512 = BigWord Mod512


-- | Data type representing a 256 bit unsigned integer.
-- It is implemented as an Integer modulo 2^256.
type Word256 = BigWord Mod256


-- | Data type representing a 160 bit unsigned integer.
-- It is implemented as an Integer modulo 2^160.
type Word160 = BigWord Mod160


-- | Data type representing a 128 bit unsigned integer.
-- It is implemented as an Integer modulo 2^128.
type Word128 = BigWord Mod128


-- | Data type representing an Integer modulo coordinate field order P.
type FieldP = BigWord ModP


-- | Data type representing an Integer modulo curve order N.
type FieldN = BigWord ModN

data Mod512
data Mod256
data Mod256Tx
data Mod256Block
data Mod160
data Mod128
data ModP
data ModN

newtype BigWord n = BigWord { getBigWordInteger :: Integer 
                            } deriving (Eq, Ord) -- change the read and show instances....

class BigWordMod a where
    maxVal ::BigWord a -> Integer 
    maxVal x = 2 ^ rBitSize x 
    
    rBitSize     :: BigWord a -> Int
    -- = ds

instance BigWordMod Mod512 where
    rBitSize _     = 512

instance BigWordMod Mod256 where
    rBitSize _     = 256

instance BigWordMod Mod256Tx where
    rBitSize _     = 256

instance BigWordMod Mod256Block where
    rBitSize _     = 256

instance BigWordMod Mod160 where
    rBitSize _     = 160

instance BigWordMod Mod128 where
    rBitSize _     = 128

instance BigWordMod ModP where
    maxVal   _ = curveP
    rBitSize _ = 256


instance BigWordMod ModN where
    maxVal   _ = curveN
    rBitSize _ = 256


---------------------------------------------------------------------------------------------------------------------------------------------------
---------------------------------------------------------------------------------------------------------------------------------------------------

instance (BigWordMod a) => Show (BigWord a) where
    
    show x@(BigWord x_) = let digits = rBitSize x `div` 4 
                           in ("0x"++). reverse . take digits $ (reverse $ showHex x_ "") ++ repeat '0'


instance Read (BigWord a) where
    readsPrec k x = first BigWord <$> readsPrec k x



------------------------------------------------------------------------------------------------------------------------------------------------------
------------------------------------------------------------------------------------------------------------------------------------------------------



rFromInteger :: forall a . (BigWordMod a) => Integer -> BigWord a   
rFromInteger  x = let max = maxVal (undefined :: BigWord a)     
                   in BigWord $ ((x `mod` max) + max) `mod` max -- make sure it yields the correct value for negative integers!

instance BigWordMod n => Num (BigWord n) where
    fromInteger = rFromInteger
    (BigWord i1) + (BigWord i2) = fromInteger $ i1 + i2
    (BigWord i1) * (BigWord i2) = fromInteger $ i1 * i2
    negate (BigWord i) = fromInteger $ negate i
    abs r = r
    signum (BigWord i) = fromInteger $ signum i


instance BigWordMod n => Bounded (BigWord n) where
    minBound = fromInteger 0
    maxBound = fromInteger (-1)


instance BigWordMod n => Real (BigWord n) where
   toRational (BigWord i) = toRational i


instance BigWordMod n => Enum (BigWord n) where
    
    succ r@(BigWord i)
      | r == maxBound = error "BigWord: tried to take succ of maxBound"
      | otherwise = fromInteger $ succ i
    
    pred r@(BigWord i)
      | r == minBound = error "BigWord: tried to take pred of minBound"
      | otherwise = fromInteger $ pred i
    
    toEnum i
      | toInteger i >= toInteger (minFrom r) && toInteger i <= toInteger (maxFrom r) = r
      | otherwise = error "BigWord: toEnum is outside of bounds"
    
          where
            r = fromInteger $ toEnum i
    
            minFrom :: BigWordMod a => BigWord a -> BigWord a
            minFrom _ = minBound

            maxFrom :: BigWordMod a => BigWord a -> BigWord a
            maxFrom _ = maxBound

    fromEnum (BigWord i) = fromEnum i


inverseP :: FieldP -> FieldP
inverseP (BigWord i) = fromInteger $ mulInverse i curveP


inverseN :: FieldN -> FieldN
inverseN (BigWord i) = fromInteger $ mulInverse i curveN


instance BigWordMod n => Integral (BigWord n) where
    (BigWord i1) `quot` (BigWord i2) = fromInteger $ i1 `quot` i2
    (BigWord i1) `rem` (BigWord i2) = fromInteger $ i1 `rem` i2
    (BigWord i1) `div` (BigWord i2) = fromInteger $ i1 `div` i2
    (BigWord i1) `mod` (BigWord i2) = fromInteger $ i1 `mod` i2
    (BigWord i1) `quotRem` (BigWord i2) = (fromInteger a, fromInteger b)
       where
        (a,b) = i1 `quotRem` i2
    (BigWord i1) `divMod` (BigWord i2) = (fromInteger a, fromInteger b)
       where
        (a,b) = i1 `divMod` i2
    
    toInteger (BigWord i) = i

{- Fractional is only defined for prime orders -}
instance Fractional (BigWord ModP) where
    recip = inverseP
    fromRational r = fromInteger (numerator r) / fromInteger (denominator r)


instance Fractional (BigWord ModN) where
    recip = inverseN
    fromRational r = fromInteger (numerator r) / fromInteger (denominator r)


{- Binary instances for serialization / deserialization -}




--isIntegerValidKey :: Integer -> Bool
--isIntegerValidKey i = i > 0 && i < curveN


-- Extended euclidean algorithm
-- Calculates the multiplicative inverse modulo p
extendedModGCD :: Integer -> Integer -> Integer -> (Integer, Integer)
extendedModGCD a b p | b == 0     = (1,0)
                     | otherwise  = (t, (s - q*t) `mod` p)
    where
        (q,r) = quotRem a b
        (s,t) = extendedModGCD b r p

        
-- Find multiplicative inverse of a : a*s = 1 (mod p)
mulInverse :: Integer -> Integer -> Integer
mulInverse a p | a*s `mod` p == 1 = s
               | otherwise        = error "No multiplicative inverse (mod p) for a"
    where
        (s,_) = extendedModGCD a p p


-- TODO, make this not necesary?
isIntegerValidKey :: Integer -> Bool
isIntegerValidKey i = i > 0 && i < curveN

--------------------------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------

instance Binary (BigWord Mod256) where
    --get = error "dddd"
    get = do a <- fromIntegral <$> getWord64be
           --  error $ show a
             b <- fromIntegral <$> getWord64be
             c <- fromIntegral <$> getWord64be
             d <- fromIntegral <$> getWord64be
             return $ (a `shiftL` 192) + (b `shiftL` 128) + (c `shiftL` 64) + d

    put (BigWord i) = do putWord64be $ fromIntegral (i `shiftR` 192)
                         putWord64be $ fromIntegral (i `shiftR` 128)
                         putWord64be $ fromIntegral (i `shiftR` 64)
                         putWord64be $ fromIntegral i


instance Binary (BigWord Mod160) where
    get = do a <- fromIntegral <$> getWord32be
             b <- fromIntegral <$> getWord64be
             c <- fromIntegral <$> getWord64be
             return $ (a `shiftL` 128) + (b `shiftL` 64) + c

    put (BigWord i) = do putWord32be $ fromIntegral (i `shiftR` 128)
                         putWord64be $ fromIntegral (i `shiftR` 64)
                         putWord64be $ fromIntegral i


 {-
- Recheck twice!! 
 -}
 -- This one is wrong!!
instance Binary (BigWord ModN) where
    get = do t <- getWord8
             
             unless (t == 0x02) (fail $  "Bad DER identifier byte " ++ (show t) ++ ". Expecting 0x02" )
             
             l <- getWord8
             i <- bsToInteger <$> getByteString (fromIntegral l)
             
             unless (i > 0 && i < curveN) $ fail $ "Invalid fieldN element: " ++ (show i) -- shouldn't be that a >= instead of a > ?

             return $ fromInteger i
    
    put (BigWord 0) = error "0 is an invalid FieldN element to serialize"
    
    put (BigWord i) = do putWord8 0x02 -- Integer type
                         
                         let b = integerToBS i
                             l = fromIntegral $ BS.length b -- recheck if this works fine, also see how this affect whether is compressed or not....
                         
                         if BS.head b >= 0x80
                             then putWord8 (l + 1) >> putWord8 0x00
                             else putWord8 l
                         
                         putByteString b -- so here finally the error is !!!!!!!!!!!!!!!


instance Binary (BigWord ModP) where
    -- Section 2.3.6 http://www.secg.org/download/aid-780/sec1-v2.pdf
    get = do (BigWord i) <- get :: Get Word256
             unless (i>= 0 && i < curveP) (fail $ "Get: Integer not in FieldP: " ++ (show i))
             return $ fromInteger i
             -- Section 2.3.7 http://www.secg.org/download/aid-780/sec1-v2.pdf
    put r = put (fromIntegral r :: Word256)


instance Binary (BigWord Mod512) where
    get = do a <- fromIntegral <$> (get :: Get Word256)
             b <- fromIntegral <$> (get :: Get Word256)
             return $ (a `shiftL` 256) + b

    put (BigWord i) = do put $ (fromIntegral (i `shiftR` 256) :: Word256)
                         put $ (fromIntegral i :: Word256)


---------------------------------------------------------------------------------------------------------------
---------------------------------------------------------------------------------------------------------------

-- | Split a 'Word512' into a pair of 'Word256'.
split512 :: Word512 -> (Word256, Word256)
split512 i = (fromIntegral $ i `shiftR` 256, fromIntegral i)


-- | Join a pair of 'Word256' into a 'Word512'.
join512 :: (Word256, Word256) -> Word512
join512 (a,b) = ((fromIntegral a :: Word512) `shiftL` 256) + (fromIntegral b :: Word512)



instance BigWordMod n => Bits (BigWord n) where
    (BigWord i1) .&.   (BigWord i2) = fromInteger $ i1 .&. i2
    (BigWord i1) .|.   (BigWord i2) = fromInteger $ i1 .|. i2
    (BigWord i1) `xor` (BigWord i2) = fromInteger $ i1 `xor` i2
    
    complement (BigWord i) = fromInteger $ complement i
    
    shift (BigWord i) j = fromInteger $ shift i j
    
    bitSize = rBitSize
    
    testBit (BigWord i) = testBit i
    
    bit n = fromInteger $ bit n
    
    popCount (BigWord i) = popCount i
    isSigned _ = False