module Language.Bitcoin.Script.Utils (
    pushNumber,
    toCScriptNum,
    fromCScriptNum,
) where

import Data.Bits (clearBit, setBit, testBit)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Word (Word8)
import Haskoin.Script (ScriptOp, opPushData)

-- | Decode a numeric stack value
fromCScriptNum :: ByteString -> Int
fromCScriptNum :: ByteString -> Int
fromCScriptNum b :: ByteString
b
    | ByteString -> Bool
BS.null ByteString
b = 0
    | Word8
msb Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x80 = Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
leWord64 ByteString
b'
    | Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
msb 7 = Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> (ByteString -> Int) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (ByteString -> Int) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
leWord64 (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Word8 -> ByteString
BS.snoc ByteString
b' (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit Word8
msb 7)
    | Bool
otherwise = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
leWord64 ByteString
b
  where
    Just (b' :: ByteString
b', msb :: Word8
msb) = ByteString -> Maybe (ByteString, Word8)
BS.unsnoc ByteString
b

-- | Encode a numeric stack value
toCScriptNum :: Int -> ByteString
toCScriptNum :: Int -> ByteString
toCScriptNum n :: Int
n
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = ByteString
BS.empty
    | Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
msb 7 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = ByteString -> Word8 -> ByteString
BS.snoc ByteString
b 0x00
    | Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
msb 7 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = ByteString -> Word8 -> ByteString
BS.snoc ByteString
b 0x80
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = ByteString -> Word8 -> ByteString
BS.snoc ByteString
b' (Word8 -> ByteString) -> Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
setBit Word8
msb 7
    | Bool
otherwise = ByteString
b
  where
    (b' :: ByteString
b', msb :: Word8
msb) = Int -> (ByteString, Word8)
intLE Int
n
    b :: ByteString
b = ByteString -> Word8 -> ByteString
BS.snoc ByteString
b' Word8
msb

pushNumber :: Int -> ScriptOp
pushNumber :: Int -> ScriptOp
pushNumber = ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> (Int -> ByteString) -> Int -> ScriptOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString
toCScriptNum

intLE :: Int -> (ByteString, Word8)
intLE :: Int -> (ByteString, Word8)
intLE = ByteString -> Int -> (ByteString, Word8)
forall t b.
(Num b, Integral t) =>
ByteString -> t -> (ByteString, b)
go ByteString
forall a. Monoid a => a
mempty (Int -> (ByteString, Word8))
-> (Int -> Int) -> Int -> (ByteString, Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
abs
  where
    go :: ByteString -> t -> (ByteString, b)
go b :: ByteString
b n :: t
n
        | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< 0xff = (ByteString
b, t -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
n)
        | Bool
otherwise = let (q :: t
q, r :: t
r) = t
n t -> t -> (t, t)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 256 in ByteString -> t -> (ByteString, b)
go (ByteString -> Word8 -> ByteString
BS.snoc ByteString
b (Word8 -> ByteString) -> Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
r) t
q

leWord64 :: ByteString -> Int
leWord64 :: ByteString -> Int
leWord64 bs :: ByteString
bs = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Word8 -> Int -> Int) -> [Word8] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word8 -> Int -> Int
forall a a. (Integral a, Num a) => a -> a -> a
mult (ByteString -> [Word8]
BS.unpack ByteString
bs) [Int]
orders
  where
    mult :: a -> a -> a
mult x :: a
x y :: a
y = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
y
    orders :: [Int]
orders = (256 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^) (Int -> Int) -> [Int] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [0 :: Int ..]