{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Bitcoin.Amount
(
BtcAmount
)
where
import Data.Ratio
import Data.Word
import PaymentChannel.Internal.Util
newtype BtcAmount = MkBitcoinAmount Word64
deriving (Eq, Ord, Generic, NFData)
instance Show BtcAmount where
show amount = show (toInteger amount) ++ " satoshi"
instance Num BtcAmount where
(MkBitcoinAmount a1) * (MkBitcoinAmount a2) = mkCapped $ fromIntegral a1 * fromIntegral a2
(MkBitcoinAmount a1) + (MkBitcoinAmount a2) = mkCapped $ fromIntegral a1 + fromIntegral a2
(MkBitcoinAmount a1) - (MkBitcoinAmount a2) = mkCapped $ fromIntegral a1 - fromIntegral a2
abs = id
signum (MkBitcoinAmount 0) = MkBitcoinAmount 0
signum (MkBitcoinAmount _) = MkBitcoinAmount 1
fromInteger = mkCapped
instance Enum BtcAmount where
toEnum = mkCapped . fromIntegral
fromEnum (MkBitcoinAmount amount) = fromIntegral amount
instance Real BtcAmount where
toRational (MkBitcoinAmount amount) = toRational amount
instance Integral BtcAmount where
toInteger (MkBitcoinAmount int) = fromIntegral int
quotRem (MkBitcoinAmount a1) (MkBitcoinAmount a2) =
(mkCapped res1, mkCapped res2)
where (res1,res2) = quotRem (fromIntegral a1) (fromIntegral a2)
instance Bounded BtcAmount where
minBound = MkBitcoinAmount 0
maxBound = MkBitcoinAmount $ round $ (21e6 :: Ratio Integer) * (1e8 :: Ratio Integer)
mkCapped :: Integer -> BtcAmount
mkCapped = MkBitcoinAmount . capTo21Mill
capTo21Mill :: Integer -> Word64
capTo21Mill i = fromIntegral $
max 0 cappedValue
where
cappedValue = min i $ fromIntegral (maxBound :: BtcAmount)
instance Serialize BtcAmount where
put = putWord64le . fromIntegral . toInteger
get = mkCapped . fromIntegral <$> getWord64le
instance ToJSON BtcAmount where
toJSON amt = Number $ scientific
(fromIntegral $ toInteger amt) 0
instance FromJSON BtcAmount where
parseJSON = withScientific "BtcAmount" $
fmap (\w -> mkCapped $ fromIntegral (w :: Word64)) . parseJSONWord