cryptoconditions 0.2.3.0 → 0.2.4

raw patch · 6 files changed

+55/−39 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 +9/−6
• Network/CryptoConditions/Encoding.hs +13/−7
• Network/CryptoConditions/Impl.hs +15/−19
• Network/CryptoConditions/Json.hs +15/−6
• cryptoconditions.cabal +1/−1
• test/TestUnits.hs +2/−0

@@ -44,6 +44,7 @@   getType (Anon 1 _ _ _) = prefixType   getType (Anon 2 _ _ _) = thresholdType   getType (Anon 4 _ _ _) = ed25519Type+  getType (Anon n _ _ cts) = CT n "UNKNOWN" (cts == mempty) ""   getType (Threshold _ _) = thresholdType   getType (Ed25519 _ _) = ed25519Type   getType (Preimage _) = preimageType@@ -68,14 +69,15 @@   getFulfillmentASN (Anon _ _ _ _) = Nothing    getSubtypes (Threshold _ sts) = thresholdSubtypes sts-  getSubtypes (Anon _ _ _ sts) = sts-  getSubtypes (Prefix _ _ c)     = prefixSubtypes c-  getSubtypes _                = mempty+  getSubtypes (Anon _ _ _ sts)  = sts+  getSubtypes (Prefix _ _ c)    = prefixSubtypes c+  getSubtypes _                 = mempty    parseFulfillment 0 = parsePreimage Preimage   parseFulfillment 1 = parsePrefix Prefix   parseFulfillment 2 = parseThreshold Threshold   parseFulfillment 4 = parseEd25519 (\a b -> Ed25519 a (Just b))+  parseFulfillment n = fail ("unknown condition type: " ++ show n)    verifyMessage (Preimage image) = verifyPreimage image   verifyMessage (Prefix pre mml cond) = verifyPrefix pre mml cond@@ -115,15 +117,16 @@   toJSON (Ed25519 pk msig) = toJsonEd25519 pk msig   toJSON (Prefix pre mml c) = toJsonPrefix pre mml c   toJSON (Preimage img) = toJsonPreimage img+  toJSON c@(Anon _ _ _ _) = toJsonAnon c    instance FromJSON Condition where   parseJSON = withObject "condition" $ \o -> do-    typeName <- o .: "type"-    let method = case typeName of+    name <- o .: "type"+    let method = case name 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)+         _                 -> fail ("Unknown Crypto-Condition type: " ++ name)     method o

@@ -59,7 +59,7 @@ asnSequence c args = [Start c] ++ args ++ [End c]  -asnChoice :: Integral i => i -> [ASN1] -> [ASN1]+asnChoice :: Int -> [ASN1] -> [ASN1] asnChoice tid asn =   let c = Container Context $ fromIntegral tid    in asnSequence c asn@@ -98,18 +98,24 @@ 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+    let ids = Set.map fromIntegral types         maxId = foldl max 0 types+        bitArray = foldl bitArraySetBit (newBitArray maxId) ids         bitsUnused = fromIntegral $ 7 - mod maxId 8      in BS.singleton bitsUnused <> bitArrayGetData bitArray  +newBitArray :: Int -> BitArray+newBitArray maxId =+  let n = ceiling $ (fromIntegral maxId+1) / 8+   in BitArray (n*8) (BS.replicate (fromIntegral n) 0)++ 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]+  let bytes = BS.tail maskbs+      capacity = 8 * BS.length bytes+      ba = BitArray (fromIntegral capacity) bytes+   in [i | i <- [0..capacity-1], bitArrayGetBit ba (fromIntegral i)]

@@ -4,30 +4,26 @@ module Network.CryptoConditions.Impl where  -import Crypto.Hash+import           Crypto.Hash import qualified Crypto.PubKey.Ed25519 as Ed2 -import Control.Monad (when)--import qualified Data.Aeson.Types as Aeson-import Data.ASN1.BinaryEncoding-import Data.ASN1.BinaryEncoding.Raw-import Data.ASN1.Encoding-import Data.ASN1.Parse-import Data.ASN1.Types-import Data.Bits+import           Data.ASN1.BinaryEncoding+import           Data.ASN1.BinaryEncoding.Raw+import           Data.ASN1.Encoding+import           Data.ASN1.Parse+import           Data.ASN1.Types import qualified Data.ByteArray as BA import qualified Data.ByteString as BS import qualified Data.ByteString.Base64.URL as B64-import Data.List (sortOn)-import Data.Maybe-import Data.Monoid+import           Data.List (sortOn)+import           Data.Maybe+import           Data.Monoid import qualified Data.Set as Set import qualified Data.Text as T-import Data.Text.Encoding (decodeUtf8)-import Data.Word+import           Data.Text.Encoding (decodeUtf8)+import           Data.Word -import Network.CryptoConditions.Encoding+import           Network.CryptoConditions.Encoding   --------------------------------------------------------------------------------@@ -222,7 +218,7 @@ verifyPrefix :: IsCondition c => Prefix -> Int -> c -> Message -> Bool verifyPrefix prefix mml cond msg =   let ok = mml >= BS.length msg-   in verifyMessage cond (prefix <> msg)+   in ok && verifyMessage cond (prefix <> msg)   --------------------------------------------------------------------------------@@ -260,7 +256,7 @@       asn = asnSequence Sequence $               asnData [BS.pack $ bytesOfUInt $ fromIntegral t] ++               asnChoice 1 (concat subs')-   in sha256 $ encodeASN1' DER asn+   in hashASN asn   thresholdSubtypes :: IsCondition c => [c] -> Set.Set ConditionType@@ -365,4 +361,4 @@     (Other Context i bs) ->       if n == i then pure bs                 else throwParseError $ "Invalid context id: " ++ show (n,i)-    other -> throwParseError "agh" -- TODO+    notOther -> throwParseError ("Unexpected element: " ++ show notOther)

@@ -5,6 +5,7 @@   , parseJsonPrefix   , parseJsonThreshold   , parseJsonEd25519+  , toJsonAnon   , toJsonPreimage   , toJsonPrefix   , toJsonThreshold@@ -32,24 +33,24 @@ -- Parsing -- -parseJsonThreshold :: (IsCondition c, FromJSON c) => (Word16 -> [c] -> c) -> Object -> Parser c+parseJsonThreshold :: 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 :: (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 :: 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 :: (ByteString -> c) -> Object -> Parser c parseJsonPreimage f obj =   f <$> (obj .: "preimage" >>= fromB64) @@ -61,15 +62,16 @@ toJsonPreimage img = object ["type" .= String "preimage-sha-256", "preimage" .= toB64 img]  -toJsonPrefix :: (IsCondition c, ToJSON c) => ByteString -> Int -> c -> Value+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 :: (IsCondition c, ToJSON c) => Word16 -> [c] -> Value+toJsonThreshold :: ToJSON c => Word16 -> [c] -> Value toJsonThreshold threshold subs =   object [ "type" .= String "threshold-sha-256"          , "threshold" .= threshold@@ -81,6 +83,13 @@ 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+          ]   -- Util

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

@@ -26,6 +26,8 @@              , [1]              , [0, 1]              , [2, 7]+             , [15, 32]+             , [155]              ]       test set = assertEqual "bit string equal" set (fromBitString $ toBitString set)    in (\s -> testCase (show s) (test $ Set.fromList s)) <$> sets