module Data.Bitcoin.PaymentChannel.Internal.Serialization where
import Data.Bitcoin.PaymentChannel.Internal.Types
import Data.Bitcoin.PaymentChannel.Internal.Util
(BitcoinAmount(..), toWord64, deserEither, toHexString)
import Data.Aeson (Value(Number), FromJSON(..), ToJSON(..),
withText, withScientific)
import Data.Aeson.Types (Parser)
import Data.Scientific (Scientific, scientific, toBoundedInteger)
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.ByteString.Lazy (toStrict, fromStrict)
import qualified Data.Binary as Bin
import qualified Data.Binary.Put as BinPut
import qualified Data.Binary.Get as BinGet
import qualified Data.ByteString.Base64.URL as B64
import qualified Data.ByteString as B
import qualified Data.Text as T
import Data.EitherR (fmapL)
instance Show Payment where
show (CPayment val sig) =
"<Payment: valLeft=" ++ show val ++
", sig=" ++ toHexString (toStrict $ Bin.encode sig) ++ ">"
-------JSON--------
padToMod4 :: B.ByteString -> B.ByteString
padToMod4 bs =
let
lastGroupSize = B.length bs `mod` 4
numPadChars = if lastGroupSize > 0 then 4 lastGroupSize else 0
in
B.concat [bs, B.replicate numPadChars 61]
b64Encode :: Bin.Binary a => a -> B.ByteString
b64Encode = B64.encode . toStrict . Bin.encode
b64Decode :: Bin.Binary a => B.ByteString -> Either String a
b64Decode b64 =
concatErr "failed to deserialize parsed base64 data: " . deserEither =<<
(concatErr "failed to parse base64 data: ") (b64Decode b64)
where
b64Decode = B64.decode . padToMod4
concatErr e = fmapL (e ++)
txtB64Encode :: Bin.Binary a => a -> T.Text
txtB64Encode = decodeLatin1 . b64Encode
txtB64Decode :: Bin.Binary a => T.Text -> Parser a
txtB64Decode = either fail return . b64Decode . encodeUtf8
instance ToJSON Payment where
toJSON = toJSON . txtB64Encode
instance FromJSON Payment where
parseJSON = withText "Payment" txtB64Decode
instance ToJSON BitcoinAmount where
toJSON amt = Number $ scientific
(fromIntegral $ toWord64 amt) 0
instance FromJSON BitcoinAmount where
parseJSON = withScientific "BitcoinAmount" $
fmap fromIntegral . parseJSONInt
instance ToJSON PaymentChannelState where
toJSON = toJSON . txtB64Encode
instance FromJSON PaymentChannelState where
parseJSON = withText "PaychanState" txtB64Decode
instance Bounded BitcoinAmount where
minBound = CMoneyAmount 0
maxBound = CMoneyAmount $ round $ 21e6 * 1e8
parseJSONInt :: Scientific -> Parser Integer
parseJSONInt s =
case toBoundedInteger s of
Just (CMoneyAmount i) -> return i
Nothing -> fail $ "failed to decode JSON number to integer. data: " ++ show s
------BINARY--------
instance Bin.Binary PaymentChannelState where
put (CPaymentChannelState par fti payConf valLeft (Just sig)) =
Bin.put par >> Bin.put fti >> Bin.put payConf >> Bin.put valLeft
>> BinPut.putWord8 1 >> Bin.put sig
put (CPaymentChannelState par fti payConf valLeft Nothing) =
Bin.put par >> Bin.put fti >> Bin.put payConf >> Bin.put valLeft
>> BinPut.putWord8 0
get = CPaymentChannelState <$> Bin.get <*> Bin.get <*>
Bin.get <*> Bin.get <*> (BinGet.getWord8 >>=
\w -> case w of
1 -> fmap Just Bin.get
_ -> return Nothing)
instance Bin.Binary ChannelParameters where
put (CChannelParameters pks pkr lt) =
Bin.put pks >> Bin.put pkr >> Bin.put lt
get = CChannelParameters <$> Bin.get <*> Bin.get <*> Bin.get
instance Bin.Binary FundingTxInfo where
put (CFundingTxInfo h idx val) =
Bin.put h >> BinPut.putWord32be idx >> Bin.put val
get = CFundingTxInfo <$> Bin.get <*> BinGet.getWord32be <*> Bin.get
instance Bin.Binary PaymentTxConfig where
put (CPaymentTxConfig sendAddr) =
Bin.put sendAddr
get = CPaymentTxConfig <$> Bin.get
instance Bin.Binary Payment where
put (CPayment val sig) = Bin.put val >> Bin.put sig
get = CPayment <$> Bin.get <*> Bin.get
instance Bin.Binary PaymentSignature where
put ps = Bin.put (psSig ps)
>> Bin.put (psSigHash ps)
get = CPaymentSignature <$> Bin.get <*> Bin.get