{-# LANGUAGE OverloadedStrings #-}
module Network.CryptoConditions.Json
( parseJsonPreimage
, parseJsonPrefix
, parseJsonThreshold
, parseJsonEd25519
, toJsonAnon
, toJsonPreimage
, toJsonPrefix
, toJsonThreshold
, toJsonEd25519
, fromB64
, toB64
) where
import Control.Monad.Fail (MonadFail)
import Crypto.PubKey.Ed25519
import Crypto.Error
import Data.Aeson
import Data.Aeson.Types
import qualified Data.ByteArray as BA
import Data.ByteString as BS
import Data.Text
import Data.Text.Encoding
import Data.Word
import Network.CryptoConditions.Encoding
import Network.CryptoConditions.Impl
parseJsonThreshold :: FromJSON c => (Word16 -> [c] -> c) -> Object -> Parser c
parseJsonThreshold f obj = f <$> obj .: "threshold" <*> obj .: "subfulfillments"
parseJsonEd25519 :: (PublicKey -> Maybe Signature -> c) -> Object -> Parser c
parseJsonEd25519 f obj = do
pub <- obj .: "publicKey" >>= parseKey publicKey
msig <- obj .:? "signature" >>= mapM (parseKey signature)
pure $ f pub msig
parseJsonPrefix :: FromJSON c => (ByteString -> Int -> c -> c) -> Object -> Parser c
parseJsonPrefix f obj = do
pre <- obj .: "prefix" >>= fromB64
f pre <$> obj .: "maxMessageLength" <*> obj .: "subfulfillment"
parseJsonPreimage :: (ByteString -> c) -> Object -> Parser c
parseJsonPreimage f obj =
f <$> (obj .: "preimage" >>= fromB64)
toJsonPreimage :: ByteString -> Value
toJsonPreimage img = object ["type" .= String "preimage-sha-256", "preimage" .= toB64 img]
toJsonPrefix :: ToJSON c => ByteString -> Int -> c -> Value
toJsonPrefix pre mml sub =
object [ "type".= String "prefix-sha-256"
, "prefix" .= toB64 pre
, "maxMessageLength" .= mml
, "subfulfillment" .= sub
]
toJsonThreshold :: ToJSON c => Word16 -> [c] -> Value
toJsonThreshold threshold subs =
object [ "type" .= String "threshold-sha-256"
, "threshold" .= threshold
, "subfulfillments" .= subs
]
toJsonEd25519 :: PublicKey -> Maybe Signature -> Value
toJsonEd25519 pk msig =
let sigItem = maybe [] (\sig -> ["signature" .= keyToJson sig]) msig
in object $ ["type" .= String "ed25519-sha-256", "publicKey" .= keyToJson pk] ++ sigItem
toJsonAnon :: IsCondition c => c -> Value
toJsonAnon cond =
object [ "type" .= (typeName $ getType cond)
, "uri" .= getConditionURI cond
]
fromB64 :: MonadFail m => Text -> m ByteString
fromB64 = either fail pure . b64DecodeStripped . encodeUtf8
parseKey :: (ByteString -> CryptoFailable b) -> Text -> Parser b
parseKey f bs = do
bin <- either fail pure $ b64DecodeStripped $ encodeUtf8 bs
onCryptoFailure (fail . show) pure $ f bin
keyToJson :: BA.ByteArrayAccess k => k -> Value
keyToJson = String . decodeUtf8 . b64EncodeStripped . BS.pack . BA.unpack
toB64 :: ByteString -> Value
toB64 = String . decodeUtf8 . b64EncodeStripped