cryptoconditions 0.2.2.2 → 0.2.3.0

raw patch · 6 files changed

+86/−102 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Network/CryptoConditions.hs +6/−11
• Network/CryptoConditions/Encoding.hs +12/−7
• Network/CryptoConditions/Impl.hs +58/−69
• cryptoconditions.cabal +1/−1
• test/TestStandard.hs +6/−11
• test/TestVectors.hs +3/−3

@@ -15,7 +15,6 @@   , ed25519Condition   , preimageCondition   , fulfillEd25519-  , readStandardFulfillment   ) where  import qualified Crypto.PubKey.Ed25519 as Ed2@@ -62,11 +61,11 @@   getFingerprint (Prefix pre mml c) = prefixFingerprint pre mml c   getFingerprint (Anon _ fp _ _) = fp -  getFulfillment (Threshold t subs) = thresholdFulfillment t subs-  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+  getFulfillmentASN (Threshold t subs) = thresholdFulfillmentASN t subs+  getFulfillmentASN (Ed25519 pk msig) = ed25519FulfillmentASN pk <$> msig+  getFulfillmentASN (Preimage pre) = Just $ preimageFulfillmentASN pre+  getFulfillmentASN (Prefix pre mml c) =  prefixFulfillmentASN pre mml c+  getFulfillmentASN (Anon _ _ _ _) = Nothing    getSubtypes (Threshold _ sts) = thresholdSubtypes sts   getSubtypes (Anon _ _ _ sts) = sts@@ -76,7 +75,7 @@   parseFulfillment 0 = parsePreimage Preimage   parseFulfillment 1 = parsePrefix Prefix   parseFulfillment 2 = parseThreshold Threshold-  parseFulfillment 4 = parseEd25519 Ed25519+  parseFulfillment 4 = parseEd25519 (\a b -> Ed25519 a (Just b))    verifyMessage (Preimage image) = verifyPreimage image   verifyMessage (Prefix pre mml cond) = verifyPrefix pre mml cond@@ -109,10 +108,6 @@ 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

@@ -4,10 +4,11 @@   ( x690SortAsn   , b64EncodeStripped   , b64DecodeStripped-  , asnSeq   , bytesOfUInt   , uIntFromBytes-  , fiveBellsContainer+  , asnData+  , asnChoice+  , asnSequence   , toData   , toKey   , parseASN1@@ -54,14 +55,18 @@ x690SortAsn = sortOn (\a -> let b = encodeASN1' DER a in (BS.length b, b))  -asnSeq :: ASN1ConstructionType -> [ASN1] -> [ASN1]-asnSeq c args = [Start c] ++ args ++ [End c]+asnSequence :: ASN1ConstructionType -> [ASN1] -> [ASN1]+asnSequence c args = [Start c] ++ args ++ [End c]  -fiveBellsContainer :: Integral i => i -> [BS.ByteString] -> [ASN1]-fiveBellsContainer tid bs =+asnChoice :: Integral i => i -> [ASN1] -> [ASN1]+asnChoice tid asn =   let c = Container Context $ fromIntegral tid-   in asnSeq c [Other Context i s | (i,s) <- zip [0..] bs]+   in asnSequence c asn+++asnData :: [BS.ByteString] -> [ASN1]+asnData bss = [Other Context i s | (i,s) <- zip [0..] bss]   bytesOfUInt :: Integer -> [Word8]

@@ -36,8 +36,8 @@ class Show c => IsCondition c where   getCost :: c -> Int   getType :: c -> ConditionType-  getFingerprint :: c -> BS.ByteString-  getFulfillment :: c -> Maybe BS.ByteString+  getFingerprint :: c -> Fingerprint+  getFulfillmentASN :: c -> Maybe [ASN1]   getSubtypes :: c -> Set.Set ConditionType   parseFulfillment :: Int -> ParseASN1 c   verifyMessage :: c -> Message -> Bool@@ -53,18 +53,18 @@   encodeCondition :: IsCondition c => c -> BS.ByteString-encodeCondition = encodeASN1' DER . encodeConditionASN+encodeCondition = encodeASN1' DER . getConditionASN  -encodeConditionASN :: IsCondition c => c -> [ASN1]-encodeConditionASN c =+getConditionASN :: IsCondition c => c -> [ASN1]+getConditionASN c =   let ct = getType c       fingerprint = getFingerprint c       costBs = BS.pack $ bytesOfUInt $ fromIntegral $ getCost c       subtypes = toBitString $ Set.map typeId $ getSubtypes c       body = [fingerprint, costBs] ++              if hasSubtypes ct then [subtypes] else []-   in fiveBellsContainer (typeId ct) body+   in asnChoice (typeId ct) $ asnData body   getConditionURI :: IsCondition c => c -> T.Text@@ -80,23 +80,26 @@        <> cost <> subtypes  -getFulfillmentBase64 :: IsCondition c => c -> Maybe T.Text-getFulfillmentBase64 =-  fmap (decodeUtf8 . B64.encode) . getFulfillment+encodeFulfillment :: IsCondition c => c -> Maybe Fulfillment+encodeFulfillment cond = encodeASN1' DER <$> getFulfillmentASN cond  -readFulfillment :: IsCondition c => Fulfillment -> Either String c-readFulfillment bs = parseASN1 bs parsePoly+encodeFulfillmentBase64 :: IsCondition c => c -> Maybe T.Text+encodeFulfillmentBase64 cond = decodeUtf8 . B64.encode <$> encodeFulfillment cond  -readFulfillmentBase64 :: IsCondition c => Fulfillment -> Either String c-readFulfillmentBase64 = readFulfillment . B64.decodeLenient +decodeFulfillment :: IsCondition c => Fulfillment -> Either String c+decodeFulfillment bs = parseASN1 bs parsePoly  -readCondition :: IsCondition c => BS.ByteString -> Either String c-readCondition bs = parseASN1 bs parseCondition+decodeFulfillmentBase64 :: IsCondition c => Fulfillment -> Either String c+decodeFulfillmentBase64 = decodeFulfillment . B64.decodeLenient  +decodeCondition :: IsCondition c => BS.ByteString -> Either String c+decodeCondition bs = parseASN1 bs parseCondition++ parsePoly :: IsCondition c => ParseASN1 c parsePoly = withContainerContext parseFulfillment @@ -150,9 +153,8 @@ preimageType = CT 0 "preimage-sha-256" False "sha-256"  -preimageFulfillment :: BS.ByteString -> Fulfillment-preimageFulfillment pre = encodeASN1' DER body-  where body = fiveBellsContainer (typeId preimageType) [pre]+preimageFulfillmentASN :: BS.ByteString -> [ASN1]+preimageFulfillmentASN pre = asnChoice 0 $ asnData [pre]   preimageCost :: BS.ByteString -> Int@@ -187,27 +189,19 @@   prefixFingerprint :: IsCondition c => Prefix -> Int -> c -> Fingerprint-prefixFingerprint pre mml cond = sha256 body-  where body = encodeASN1' DER asn-        mmlbs = BS.pack $ bytesOfUInt $ fromIntegral mml-        condAsn = encodeConditionASN cond-        asn = asnSeq Sequence $-              [ Other Context 0 pre-              , Other Context 1 mmlbs-              ] ++ asnSeq (Container Context 2) condAsn+prefixFingerprint pre mml cond = hashASN $ asn+  where+    mmlbs = BS.pack $ bytesOfUInt $ fromIntegral mml+    condAsn = getConditionASN cond+    asn = asnSequence Sequence $ asnData [pre, mmlbs] ++ asnChoice 2 condAsn  -prefixFulfillment :: IsCondition c => Prefix -> Int -> c -> Maybe Fulfillment-prefixFulfillment pre mml cond =+prefixFulfillmentASN :: IsCondition c => Prefix -> Int -> c -> Maybe [ASN1]+prefixFulfillmentASN pre mml cond =   let mmlbs = BS.pack $ bytesOfUInt $ fromIntegral mml-      msubffill = getFulfillment cond-      getAsn subffill =-        let subAsn = either (error . show) id $ decodeASN1' DER $ subffill-         in asnSeq (Container Context 1) $-             [ Other Context 0 pre-             , Other Context 1 mmlbs-             ] ++ asnSeq (Container Context 2) subAsn-   in encodeASN1' DER . getAsn <$> msubffill+      getAsn subasn =+        asnChoice 1 $ asnData [pre, mmlbs] ++ asnChoice 2 subasn+   in getAsn <$> getFulfillmentASN cond   prefixSubtypes :: IsCondition c => c -> Set.Set ConditionType@@ -221,7 +215,7 @@ parsePrefix construct = do   (pre, mmlbs) <- (,) <$> parseOther 0 <*> parseOther 1   let mml = fromIntegral $ uIntFromBytes $ BS.unpack mmlbs-  cond <- onNextContainer (Container Context 2) parsePoly+  cond <- parseContainer 2 parsePoly   pure $ construct pre mml cond  @@ -239,19 +233,15 @@ thresholdType = CT 2 "threshold-sha-256" True "sha-256"  -thresholdFulfillment :: IsCondition c => Word16 -> [c] -> Maybe Fulfillment-thresholdFulfillment t subs =+thresholdFulfillmentASN :: IsCondition c => Word16 -> [c] -> Maybe [ASN1]+thresholdFulfillmentASN t subs =   let ti = fromIntegral t-      withFf = zip subs (getFulfillment <$> subs)+      withFf = zip subs (getFulfillmentASN <$> subs)       byCost = sortOn ffillCost withFf       ffills = take ti $ catMaybes $ snd <$> byCost-      conds = encodeConditionASN . fst <$> drop ti byCost-      ffills' = either (error . show) id . decodeASN1' DER <$> ffills-      asn = asnSeq (Container Context 2) $-              asnSeq (Container Context 0) (concat ffills') ++-              asnSeq (Container Context 1) (concat conds)-      encoded = encodeASN1' DER asn-   in if length ffills == ti then Just encoded else Nothing+      conds = getConditionASN . fst <$> drop ti byCost+      asn = asnChoice 2 $ asnChoice 0 (concat ffills) ++ asnChoice 1 (concat conds)+   in if length ffills == ti then Just asn else Nothing   where     -- order by has ffill then cost of ffill     ffillCost (c, Just _) = (0::Int, getCost c)@@ -260,18 +250,16 @@  thresholdFingerprint :: IsCondition c => Word16 -> [c] -> Fingerprint thresholdFingerprint t subs =-  let asns = encodeConditionASN <$> subs+  let asns = getConditionASN <$> subs    in thresholdFingerprintFromAsns t asns   thresholdFingerprintFromAsns :: Word16 -> [[ASN1]] -> Fingerprint thresholdFingerprintFromAsns t asns =    let subs' = x690SortAsn asns-      c = Container Context 1-      asn = asnSeq Sequence $-        [ Other Context 0 (BS.pack $ bytesOfUInt $ fromIntegral t)-        , Start c-        ] ++ concat subs' ++ [End c]+      asn = asnSequence Sequence $+              asnData [BS.pack $ bytesOfUInt $ fromIntegral t] +++              asnChoice 1 (concat subs')    in sha256 $ encodeASN1' DER asn  @@ -290,8 +278,8 @@  parseThreshold :: IsCondition c => (Word16 -> [c] -> c) -> ParseASN1 c parseThreshold construct = do-  ffills <- onNextContainer (Container Context 0) $ getMany parsePoly-  conds <- onNextContainer (Container Context 1) $ getMany parseCondition+  ffills <- parseContainer 0 $ getMany parsePoly+  conds <- parseContainer 1 $ getMany parseCondition   let t = fromIntegral $ length ffills   pure $ construct t (conds ++ ffills) @@ -322,33 +310,26 @@   ed25519Fingerprint :: Ed2.PublicKey -> Fingerprint-ed25519Fingerprint pk = sha256 body-  where body = encodeASN1' DER asn-        asn = [ Start Sequence-              , Other Context 0 $ toData pk-              ]+ed25519Fingerprint pk =+  hashASN $ asnSequence Sequence $ asnData [toData pk]  -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+ed25519FulfillmentASN :: Ed2.PublicKey -> Ed2.Signature -> [ASN1]+ed25519FulfillmentASN pk sig = asnChoice 4 $ asnData [toData pk, toData sig]  -parseEd25519 :: (Ed2.PublicKey -> Maybe Ed2.Signature -> c) -> ParseASN1 c+parseEd25519 :: (Ed2.PublicKey -> 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)-              <*> msig+              <*> toKey (Ed2.signature bssig)   verifyEd25519 :: Ed2.PublicKey -> Ed2.Signature -> Message -> Bool verifyEd25519 pk = flip (Ed2.verify pk) + -------------------------------------------------------------------------------- -- Utilities @@ -357,6 +338,10 @@ sha256 a = BS.pack $ BA.unpack $ (hash a :: Digest SHA256)  +hashASN :: [ASN1] -> Fingerprint+hashASN = sha256 . encodeASN1' DER++ withContainerContext :: (Int -> ParseASN1 a) -> ParseASN1 a withContainerContext fp = do   asn <- getNext@@ -367,6 +352,10 @@       if end /= End c then throwParseError "Failed parsing end"                       else pure res     other -> throwParseError ("Not a container context: " ++ show other)+++parseContainer :: Int -> ParseASN1 a -> ParseASN1 a+parseContainer = onNextContainer . Container Context   parseOther :: Int -> ParseASN1 BS.ByteString

@@ -1,5 +1,5 @@ name:                cryptoconditions-version:             0.2.2.2+version:             0.2.3.0 synopsis:            Interledger Crypto-Conditions description:         Please see README.md homepage:            https://github.com/libscott/cryptoconditions-hs

@@ -37,12 +37,6 @@    , testFulfill "Test prefixed" $       Prefix "a" 20 ed2Alice-  -  , testCase "Test read fulfillment empty signatures" $-      let (Just ffillBin) = getFulfillment ed2Alice-          (Right cond') = readFulfillment ffillBin-       in assertEqual "Can decode unfulfilled fulfillment" ed2Alice cond'-   ]  @@ -53,12 +47,13 @@   let msg = umsg       uri = getConditionURI cond       badFfill = fulfillEd25519 pkAlice skEve umsg cond-      (Just ffillBin) = getFulfillment badFfill+      (Just ffillBin) = encodeFulfillment badFfill       goodFfill = fulfillEd25519 pkAlice skAlice umsg cond-  assertBool "can get fulfillment payload without signature" $ -      Nothing /= getFulfillment cond-  assertEqual "get uri from bad fulfillment"-    (Right uri) $ getConditionURI <$> readStandardFulfillment ffillBin+      econd = decodeFulfillment ffillBin :: Either String Condition+  assertEqual "can not get fulfillment payload without signature"+      Nothing $ encodeFulfillment cond+  assertEqual "get uri from good fulfillment"+    (Right uri) $ getConditionURI <$> econd   assertBool "wrong sig right message does not validate" $       not $ validate uri badFfill msg   assertBool "wrong msg right sig does not validate" $

@@ -43,11 +43,11 @@ testVectors :: String -> TestTree testVectors file = testGroup file   [ testCase "encodeCondition" $ encodeCondition cond @?= condBin-  , testCase "getFulfillment" $ getFulfillment cond @?= Just ffillBin+  , testCase "encodeFulfillment" $ encodeFulfillment cond @?= Just ffillBin   , testCase "getConditionURI" $ getConditionURI cond @?= condUri   , testCase "validate" $ validate condUri cond msg @?= True-  , testCase "readCondition" $-      let econd = readCondition condBin :: Either String Condition+  , testCase "decodeCondition" $+      let econd = decodeCondition condBin :: Either String Condition        in (getConditionURI <$> econd) @?= Right condUri   ]   where