Merge pull request #401 from GambolingPangolin/fingerprint-aeson-instances

Adds aeson instances for Fingerprint

CHANGELOG.md

@@ -6,8 +6,8 @@ and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.
 
 ## 0.21.0
 ### Changed
-- Use a newtype for Fingerprint, which uses an 8 digit hex string for IsString,
-  Read, & Show.  This fixes inconsistent (de)serialization across the package.
+- Use a newtype for Fingerprint, which uses an 8 digit hex string for various
+  instances.  This fixes inconsistent (de)serialization across the package.
 
 ### Fixed
 - Makes `finalScriptWitness` field encoding conform to bitcoin core.

src/Haskoin/Keys/Extended.hs

@@ -21,6 +21,8 @@ module Haskoin.Keys.Extended
     , ChainCode
     , KeyIndex
     , Fingerprint
+    , fingerprintToText
+    , textToFingerprint
     , DerivationException(..)
     , makeXPrvKey
     , deriveXPubKey
@@ -135,7 +137,9 @@ import           Haskoin.Address
 import           Haskoin.Constants
 import           Haskoin.Crypto.Hash
 import           Haskoin.Keys.Common
-import           Haskoin.Keys.Extended.Internal (Fingerprint (..))
+import           Haskoin.Keys.Extended.Internal (Fingerprint (..),
+                                                 fingerprintToText,
+                                                 textToFingerprint)
 import           Haskoin.Script
 import           Haskoin.Util
 import           Text.Read                      as R

src/Haskoin/Keys/Extended/Internal.hs

@@ -3,10 +3,15 @@
 {-# LANGUAGE TypeApplications           #-}
 
 module Haskoin.Keys.Extended.Internal (
-    Fingerprint (..)
+    Fingerprint (..),
+    fingerprintToText,
+    textToFingerprint,
 ) where
 
 import           Control.DeepSeq   (NFData)
+import           Control.Monad     ((>=>))
+import           Data.Aeson        (FromJSON, ToJSON, parseJSON, toJSON,
+                                    withText)
 import           Data.Binary       (Binary (..))
 import           Data.Bytes.Get    (getWord32be)
 import           Data.Bytes.Put    (putWord32be)
@@ -17,17 +22,24 @@ import           Data.Maybe        (fromMaybe)
 import           Data.Serialize    (Serialize (..))
 import qualified Data.Serialize    as S
 import           Data.String       (IsString (..))
+import           Data.Text         (Text)
 import qualified Data.Text         as Text
 import           Data.Typeable     (Typeable)
 import           Data.Word         (Word32)
 import           GHC.Generics      (Generic)
 import           Haskoin.Util      (decodeHex, encodeHex)
-import           Text.Read         (readPrec)
+import           Text.Read         (readEither, readPrec)
 
 -- | Fingerprint of parent
 newtype Fingerprint = Fingerprint { unFingerprint :: Word32 }
     deriving (Eq, Ord, Hashable, Typeable, Generic, NFData)
 
+fingerprintToText :: Fingerprint -> Text
+fingerprintToText = encodeHex . S.encode
+
+textToFingerprint :: Text -> Either String Fingerprint
+textToFingerprint = maybe (Left "Fingerprint: invalid hex") Right . decodeHex >=> S.decode
+
 instance Show Fingerprint where
     show = show . Text.unpack . encodeHex . S.encode
 
@@ -58,3 +70,9 @@ instance Binary Fingerprint where
 instance Serialize Fingerprint where
     put = serialize
     get = deserialize
+
+instance FromJSON Fingerprint where
+    parseJSON = withText "Fingerprint" $ either fail pure . textToFingerprint
+
+instance ToJSON Fingerprint where
+    toJSON = toJSON . fingerprintToText