cryptoconditions 0.1.0.0 → 0.2.2.1

raw patch · 6 files changed

+195/−48 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Network/CryptoConditions.hs +36/−9
• Network/CryptoConditions/Encoding.hs +22/−1
• Network/CryptoConditions/Impl.hs +27/−35
• Network/CryptoConditions/Json.hs +102/−0
• cryptoconditions.cabal +4/−1
• test/Tests.hs +4/−2

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- Crypto Conditions Standard API --@@ -18,11 +20,14 @@  import qualified Crypto.PubKey.Ed25519 as Ed2 +import Data.Aeson.Types import Data.ByteString as BS+import Data.Monoid import Data.Word import qualified Data.Set as Set  import Network.CryptoConditions.Impl as CCI+import Network.CryptoConditions.Json as CCJ   data Condition =@@ -37,6 +42,7 @@  instance IsCondition Condition where   getType (Anon 0 _ _ _) = preimageType+  getType (Anon 1 _ _ _) = prefixType   getType (Anon 2 _ _ _) = thresholdType   getType (Anon 4 _ _ _) = ed25519Type   getType (Threshold _ _) = thresholdType@@ -57,7 +63,7 @@   getFingerprint (Anon _ fp _ _) = fp    getFulfillment (Threshold t subs) = thresholdFulfillment t subs-  getFulfillment (Ed25519 pk msig) = ed25519Fulfillment pk <$> msig+  getFulfillment (Ed25519 pk msig) = ed25519Fulfillment pk msig   getFulfillment (Preimage pre) = Just $ preimageFulfillment pre   getFulfillment (Prefix pre mml c) =  prefixFulfillment pre mml c   getFulfillment (Anon _ _ _ _) = Nothing@@ -70,7 +76,7 @@   parseFulfillment 0 = parsePreimage Preimage   parseFulfillment 1 = parsePrefix Prefix   parseFulfillment 2 = parseThreshold Threshold-  parseFulfillment 4 = parseEd25519 (\a b -> Ed25519 a (Just b))+  parseFulfillment 4 = parseEd25519 Ed25519    verifyMessage (Preimage image) = verifyPreimage image   verifyMessage (Prefix pre mml cond) = verifyPrefix pre mml cond@@ -94,14 +100,35 @@ ed25519Condition pk = Ed25519 pk Nothing  -fulfillEd25519 :: Ed2.PublicKey -> Ed2.Signature-               -> Condition -> Condition-fulfillEd25519 pk sig (Threshold t subs) =-  Threshold t $ fulfillEd25519 pk sig <$> subs-fulfillEd25519 pk sig e@(Ed25519 pk' Nothing) =-  if pk == pk' then Ed25519 pk (Just sig) else e-fulfillEd25519 _ _ c = c+fulfillEd25519 :: Ed2.PublicKey -> Ed2.SecretKey+               -> Message -> Condition -> Condition+fulfillEd25519 pk sk msg c@(Ed25519 pk' _) =+  if pk == pk' then Ed25519 pk (Just $ Ed2.sign sk pk msg) else c+fulfillEd25519 pk sk msg (Threshold t subs) =+  Threshold t $ fulfillEd25519 pk sk msg <$> subs+fulfillEd25519 pk sk msg (Prefix pre mml sub) =+  Prefix pre mml $ fulfillEd25519 pk sk (pre <> msg) sub+fulfillEd25519 _ _ _ c = c   readStandardFulfillment :: Fulfillment -> Either String Condition readStandardFulfillment = readFulfillment+++instance ToJSON Condition where+  toJSON (Threshold t subs) = toJsonThreshold t subs+  toJSON (Ed25519 pk msig) = toJsonEd25519 pk msig+  toJSON (Prefix pre mml c) = toJsonPrefix pre mml c+  toJSON (Preimage img) = toJsonPreimage img+++instance FromJSON Condition where+  parseJSON = withObject "condition" $ \o -> do+    typeName <- o .: "type"+    let method = case typeName of+         "preimage-sha-256" -> CCJ.parseJsonPreimage Preimage+         "prefix-sha-256" -> parseJsonPrefix Prefix+         "threshold-sha-256" -> parseJsonThreshold Threshold+         "ed25519-sha-256" -> parseJsonEd25519 Ed25519+         _                 -> fail ("Unknown Crypto-Condition type: " ++ typeName)+    method o

@@ -11,6 +11,8 @@   , toData   , toKey   , parseASN1+  , toBitString+  , fromBitString   ) where  @@ -18,6 +20,7 @@  import Data.ASN1.BinaryEncoding import Data.ASN1.BinaryEncoding.Raw+import Data.ASN1.BitArray import Data.ASN1.Encoding import Data.ASN1.Parse import Data.ASN1.Types@@ -29,6 +32,7 @@ import qualified Data.ByteString.Char8 as C8 import Data.List (sortOn) import Data.Monoid+import qualified Data.Set as Set import Data.Word  @@ -40,7 +44,7 @@   b64DecodeStripped :: BS.ByteString -> Either String BS.ByteString-b64DecodeStripped bs = +b64DecodeStripped bs =   let r = 4 - mod (BS.length bs) 4       n = if r == 4 then 0 else r    in B64.decode $ bs <> C8.replicate n '='@@ -87,3 +91,20 @@  toData :: BA.ByteArrayAccess a => a -> BS.ByteString toData = BS.pack . BA.unpack+++-- TODO: Support larger bitstrings++toBitString :: Set.Set Int -> BS.ByteString+toBitString types =+    let words = Set.map fromIntegral types+        bitArray = foldl bitArraySetBit (BitArray 32 "\0") words+        maxId = foldl max 0 types+        bitsUnused = fromIntegral $ 7 - mod maxId 8+     in BS.singleton bitsUnused <> bitArrayGetData bitArray+++fromBitString :: BS.ByteString -> Set.Set Int+fromBitString maskbs = Set.fromList $+  let [_, w] = fromIntegral <$> BS.unpack maskbs :: [Int]+   in filter (\i -> 0 /= w .&. (shiftL 1 (7-i))) [0..7]

@@ -9,6 +9,7 @@  import Control.Monad (when) +import qualified Data.Aeson.Types as Aeson import Data.ASN1.BinaryEncoding import Data.ASN1.BinaryEncoding.Raw import Data.ASN1.Encoding@@ -60,7 +61,7 @@   let ct = getType c       fingerprint = getFingerprint c       costBs = BS.pack $ bytesOfUInt $ fromIntegral $ getCost c-      subtypes = "\a" <> (typeMask $ Set.map typeId $ getSubtypes c)+      subtypes = toBitString $ Set.map typeId $ getSubtypes c       body = [fingerprint, costBs] ++              if hasSubtypes ct then [subtypes] else []    in fiveBellsContainer (typeId ct) body@@ -92,15 +93,29 @@ readFulfillmentBase64 = readFulfillment . B64.decodeLenient   +readCondition :: IsCondition c => BS.ByteString -> Either String c+readCondition bs = parseASN1 bs parseCondition++ parsePoly :: IsCondition c => ParseASN1 c parsePoly = withContainerContext parseFulfillment   validate :: IsCondition c => T.Text -> c -> Message -> Bool validate condUri ffill msg =-  verifyMessage ffill msg && getConditionURI ffill == condUri +  verifyMessage ffill msg && getConditionURI ffill == condUri  +parseCondition :: IsCondition c => ParseASN1 c+parseCondition = withContainerContext $ \tid -> do+  (bs, costbs) <- (,) <$> parseOther 0 <*> parseOther 1+  let cost = fromIntegral $ uIntFromBytes $ BS.unpack costbs+      condPart = anon tid bs cost+  subtypes <- if hasSubtypes $ getType $ condPart mempty+                 then fromBitString <$> parseOther 2 else pure mempty+  pure $ condPart subtypes++ -------------------------------------------------------------------------------- -- | Type of a condition --@@ -123,27 +138,10 @@   ct <= ct' = typeId ct <= typeId ct'  --- Functions for working with sets of condition types--- typeNames :: Set.Set ConditionType -> T.Text typeNames = T.intercalate "," . map typeName . Set.toAscList  --- This should figure prepend the range itself.-typeMask :: Set.Set Int -> BS.ByteString-typeMask cts =-  let op i = shiftL 1 (7 - mod i 8)-      bits = Set.map op cts-      mask = foldl (.|.) 0 bits :: Int-   in BS.singleton $ fromIntegral mask---unTypeMask :: BS.ByteString -> Set.Set Int-unTypeMask maskbs = Set.fromList $-  let [n, w] = fromIntegral <$> BS.unpack maskbs-   in filter (\i -> 0 /= w .&. (shiftL 1 (n-i))) [0..n]-- -------------------------------------------------------------------------------- -- | (0) Preimage Condition --@@ -268,7 +266,7 @@  thresholdFingerprintFromAsns :: Word16 -> [[ASN1]] -> Fingerprint thresholdFingerprintFromAsns t asns = -  let subs' = x690SortAsn asns -- TODO: encode only once?+  let subs' = x690SortAsn asns       c = Container Context 1       asn = asnSeq Sequence $         [ Other Context 0 (BS.pack $ bytesOfUInt $ fromIntegral t)@@ -298,16 +296,6 @@   pure $ construct t (conds ++ ffills)  -parseCondition :: IsCondition c => ParseASN1 c-parseCondition = withContainerContext $ \tid -> do-  (bs, costbs) <- (,) <$> parseOther 0 <*> parseOther 1-  let cost = fromIntegral $ uIntFromBytes $ BS.unpack costbs-      condPart = anon tid bs cost-  subtypes <- if hasSubtypes $ getType $ condPart mempty-                 then unTypeMask <$> parseOther 2 else pure mempty-  pure $ condPart subtypes-- verifyThreshold :: IsCondition c => Word16 -> [c] -> Message -> Bool verifyThreshold m subs msg =   let m' = fromIntegral m@@ -341,17 +329,21 @@               ]  -ed25519Fulfillment :: Ed2.PublicKey -> Ed2.Signature -> Fulfillment-ed25519Fulfillment pk sig = encodeASN1' DER body-  where body = fiveBellsContainer (typeId ed25519Type) [toData pk, toData sig]+ed25519Fulfillment :: Ed2.PublicKey -> Maybe Ed2.Signature -> Maybe Fulfillment+ed25519Fulfillment pk msig = Just $ encodeASN1' DER body+  where body = fiveBellsContainer (typeId ed25519Type) [toData pk, sig]+        sig = maybe "" toData msig  -parseEd25519 :: (Ed2.PublicKey -> Ed2.Signature -> c) -> ParseASN1 c+parseEd25519 :: (Ed2.PublicKey -> Maybe Ed2.Signature -> c) -> ParseASN1 c parseEd25519 construct = do   (bspk, bssig) <- (,) <$> parseOther 0 <*> parseOther 1+  let msig = case bssig of+                  "" -> pure Nothing+                  bs -> Just <$> (toKey (Ed2.signature bs))   either throwParseError pure $     construct <$> toKey (Ed2.publicKey bspk)-              <*> toKey (Ed2.signature bssig)+              <*> msig   verifyEd25519 :: Ed2.PublicKey -> Ed2.Signature -> Message -> Bool

@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.CryptoConditions.Json+  ( parseJsonPreimage+  , parseJsonPrefix+  , parseJsonThreshold+  , parseJsonEd25519+  , toJsonPreimage+  , toJsonPrefix+  , toJsonThreshold+  , toJsonEd25519+  ) where+++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+++-- Parsing+--++parseJsonThreshold :: (IsCondition c, FromJSON c) => (Word16 -> [c] -> c) -> Object -> Parser c+parseJsonThreshold f obj = f <$> obj .: "threshold" <*> obj .: "subfulfillments"+++parseJsonEd25519 :: IsCondition c => (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 :: (IsCondition c, FromJSON c) => (ByteString -> Int -> c -> c) -> Object -> Parser c+parseJsonPrefix f obj = do+  pre <- obj .: "prefix" >>= fromB64+  f pre <$> obj .: "maxMessageLength" <*> obj .: "subfulfillment"+++parseJsonPreimage :: IsCondition c => (ByteString -> c) -> Object -> Parser c+parseJsonPreimage f obj =+  f <$> (obj .: "preimage" >>= fromB64)+++-- Encoding+--++toJsonPreimage :: ByteString -> Value+toJsonPreimage img = object ["type" .= String "preimage-sha-256", "preimage" .= binToJson img]+++toJsonPrefix :: (IsCondition c, ToJSON c) => ByteString -> Int -> c -> Value+toJsonPrefix pre mml sub =+  object [ "type".= String "prefix-sha-256"+         , "prefix" .= binToJson pre+         , "subfulfillment" .= sub+         ]+++toJsonThreshold :: (IsCondition c, 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+++-- Util+--++fromB64 :: Text -> Parser 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+++binToJson :: ByteString -> Value+binToJson = String . decodeUtf8 . b64EncodeStripped

@@ -1,5 +1,5 @@ name:                cryptoconditions-version:             0.1.0.0+version:             0.2.2.1 synopsis:            Interledger Crypto-Conditions description:         Please see README.md homepage:            https://github.com/libscott/cryptoconditions-hs@@ -18,7 +18,9 @@   exposed-modules:     Network.CryptoConditions                      , Network.CryptoConditions.Encoding                      , Network.CryptoConditions.Impl+                     , Network.CryptoConditions.Json   build-depends:       base >= 4.7 && < 5+                     , aeson                      , asn1-encoding                      , asn1-parse                      , asn1-types@@ -41,6 +43,7 @@                      , base16-bytestring                      , base64-bytestring                      , bytestring+                     , containers                      , cryptonite                      , aeson-quick                      , text

@@ -3,13 +3,15 @@ import Test.Tasty import Test.Tasty.HUnit -import TestFiveBells import TestStandard+import TestUnits+import TestVectors   main :: IO ()-main = defaultMain $ testGroup "Tests" [ fiveBellsSuite+main = defaultMain $ testGroup "Tests" [ unitTests                                        , standardTests+                                       , vectorSuite                                        ]