From a6602a18050a04a37129e89cbd38b55dbef13712 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Fri, 21 Jan 2022 17:08:11 +0100 Subject: [PATCH 01/19] Write DID signature verification & tests --- hs-ucan/library/Web/DID/Verification.hs | 27 ++++++ hs-ucan/test/Main.hs | 7 +- hs-ucan/test/Test/{Web/UCAN => }/Prelude.hs | 2 +- hs-ucan/test/Test/Web/DID.hs | 89 +++++++++++++++++++ hs-ucan/test/Test/Web/UCAN.hs | 4 +- .../test/Test/Web/UCAN/DelegationSemantics.hs | 2 +- hs-ucan/test/Test/Web/UCAN/Example.hs | 2 +- 7 files changed, 126 insertions(+), 7 deletions(-) create mode 100644 hs-ucan/library/Web/DID/Verification.hs rename hs-ucan/test/Test/{Web/UCAN => }/Prelude.hs (96%) create mode 100644 hs-ucan/test/Test/Web/DID.hs diff --git a/hs-ucan/library/Web/DID/Verification.hs b/hs-ucan/library/Web/DID/Verification.hs new file mode 100644 index 000000000..02feaaade --- /dev/null +++ b/hs-ucan/library/Web/DID/Verification.hs @@ -0,0 +1,27 @@ +module Web.DID.Verification + ( verifySignature + ) where + +import Crypto.Hash.Algorithms +import qualified Crypto.Key.Asymmetric as Key +import qualified Crypto.PubKey.Ed25519 +import qualified Crypto.PubKey.RSA.PKCS15 +import RIO + +import Web.DID.Types +import qualified Web.UCAN.Signature.Error as Signature +import qualified Web.UCAN.Signature.RS256.Types as RSA +import Web.UCAN.Signature.Types as Signature + + +verifySignature :: DID -> ByteString -> Signature -> Either Signature.Error Bool +verifySignature DID{ publicKey } signedData signature = + case (publicKey, signature) of + (Key.Ed25519PublicKey pk, Signature.Ed25519 sig) -> + Right $ Crypto.PubKey.Ed25519.verify pk signedData sig + + (Key.RSAPublicKey pk, Signature.RS256 (RSA.Signature sig)) -> do + Right $ Crypto.PubKey.RSA.PKCS15.verify (Just SHA256) pk signedData sig + + (_, _) -> + Left Signature.SignatureDoesNotMatch diff --git a/hs-ucan/test/Main.hs b/hs-ucan/test/Main.hs index 4dcbb83cb..eb2cda92d 100644 --- a/hs-ucan/test/Main.hs +++ b/hs-ucan/test/Main.hs @@ -1,11 +1,14 @@ module Main (main) where -import Test.Web.UCAN.Prelude +import Test.Prelude import qualified Test.Web.UCAN as UCAN +import qualified Test.Web.DID as DID main :: IO () main = do - spec <- testSpecs $ parallel UCAN.spec + spec <- testSpecs $ parallel $ describe "Web" do + UCAN.spec + DID.spec defaultMain $ testGroup "Tests" spec diff --git a/hs-ucan/test/Test/Web/UCAN/Prelude.hs b/hs-ucan/test/Test/Prelude.hs similarity index 96% rename from hs-ucan/test/Test/Web/UCAN/Prelude.hs rename to hs-ucan/test/Test/Prelude.hs index 0723e47f2..8397a21fd 100644 --- a/hs-ucan/test/Test/Web/UCAN/Prelude.hs +++ b/hs-ucan/test/Test/Prelude.hs @@ -1,4 +1,4 @@ -module Test.Web.UCAN.Prelude +module Test.Prelude ( module RIO , module Data.Aeson diff --git a/hs-ucan/test/Test/Web/DID.hs b/hs-ucan/test/Test/Web/DID.hs new file mode 100644 index 000000000..ab9b79f29 --- /dev/null +++ b/hs-ucan/test/Test/Web/DID.hs @@ -0,0 +1,89 @@ +module Test.Web.DID (spec) where + +import Data.Aeson as JSON +import qualified Data.Aeson.Types as JSON + +import Web.DID.Types as DID + +import qualified Crypto.Key.Asymmetric.Algorithm.Types as Alg + +import Test.Prelude +import qualified Web.DID.Verification as DID +import qualified Web.UCAN.Signature as Signature +import qualified Web.UCAN.Signature.Error as Signature + + +spec :: Spec +spec = + describe "DID" do + describe "serialisation" do + itsProp' "seralized is isomorphic to ADT" \(did :: DID) -> + JSON.eitherDecode (JSON.encode did) `shouldBe` Right did + + describe "fixtures" do + + describe "Ed25519" do + it "verifies alice's signature" do + runSignatureTest Alg.Ed25519 + aliceDIDEncoded + helloWorld + aliceHelloWorldSignature + `shouldBe` + Success (Right True) + + it "verifies bob's signature" do + runSignatureTest Alg.Ed25519 + bobDIDEncoded + helloWorld + bobHelloWorldSignature + `shouldBe` + Success (Right True) + + it "rejects alice imitating bob" do + runSignatureTest Alg.Ed25519 + bobDIDEncoded + helloWorld + aliceHelloWorldSignature + `shouldBe` + Success (Right False) + + it "rejects changed signed data" do + runSignatureTest Alg.Ed25519 + aliceDIDEncoded + somethingElse + aliceHelloWorldSignature + `shouldBe` + Success (Right False) + + +runSignatureTest :: Alg.Algorithm -> Text -> ByteString -> Text -> JSON.Result (Either Signature.Error Bool) +runSignatureTest alg didEncoded signedData sigEncoded = + fmap + (\(did, signature) -> DID.verifySignature did signedData signature) + (parseDIDAndSignature alg didEncoded sigEncoded) + + +parseDIDAndSignature :: Alg.Algorithm -> Text -> Text -> JSON.Result (DID, Signature.Signature) +parseDIDAndSignature alg didEncoded signatureEncoded = do + did <- JSON.fromJSON @DID $ JSON.String didEncoded + sig <- JSON.parse (Signature.parse alg) $ JSON.String signatureEncoded + return (did, sig) + + +helloWorld :: ByteString +helloWorld = "Hello, World!" + +somethingElse :: ByteString +somethingElse = "Something else" + +aliceDIDEncoded :: Text +aliceDIDEncoded = "did:key:z6Mkk89bC3JrVqKie71YEcc5M1SMVxuCgNx6zLZ8SYJsxALi" + +aliceHelloWorldSignature :: Text +aliceHelloWorldSignature = "tzgopgnzTfvRbaOP+COtqvQJVOfNSKHjlwXz9iMtY/fSWutcCqoeIZqNZwQygu+ntMhsVAst/Rte6I6vAv80AA" + +bobDIDEncoded :: Text +bobDIDEncoded = "did:key:z6MkffDZCkCTWreg8868fG1FGFogcJj5X6PY93pPcWDn9bob" + +bobHelloWorldSignature :: Text +bobHelloWorldSignature = "PV9pjuzha64gVXCUHghTN3aa6r1lKFOdmH4OJPshDBEgqATA06jWojW377RQQClOyWqRmaNkjQ93UyJvteP9Cg" diff --git a/hs-ucan/test/Test/Web/UCAN.hs b/hs-ucan/test/Test/Web/UCAN.hs index e8802641d..f0cd9f6b5 100644 --- a/hs-ucan/test/Test/Web/UCAN.hs +++ b/hs-ucan/test/Test/Web/UCAN.hs @@ -6,7 +6,7 @@ import qualified RIO.ByteString.Lazy as Lazy import qualified RIO.Char as Char import Web.UCAN.Types -import Test.Web.UCAN.Prelude +import Test.Prelude import qualified Test.Web.UCAN.DelegationSemantics as DelegationSemantics import Test.Web.UCAN.Example @@ -14,7 +14,7 @@ import Test.Web.UCAN.Example spec :: Spec spec = - describe "Web.UCAN" do + describe "UCAN" do describe "serialization" do itsProp' "serialized is isomorphic to ADT" \(ucan :: UCAN () Resource Potency) -> JSON.eitherDecode (JSON.encode ucan) `shouldBe` Right ucan diff --git a/hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs b/hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs index 4ce976dcb..faa9e66cd 100644 --- a/hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs +++ b/hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs @@ -7,7 +7,7 @@ module Test.Web.UCAN.DelegationSemantics , partialOrderProperties ) where -import Test.Web.UCAN.Prelude +import Test.Prelude import Web.UCAN.Proof.Class import Web.UCAN.Proof.Properties diff --git a/hs-ucan/test/Test/Web/UCAN/Example.hs b/hs-ucan/test/Test/Web/UCAN/Example.hs index a69e1537e..dbe369f5d 100644 --- a/hs-ucan/test/Test/Web/UCAN/Example.hs +++ b/hs-ucan/test/Test/Web/UCAN/Example.hs @@ -5,7 +5,7 @@ module Test.Web.UCAN.Example ) where import qualified RIO.Text as Text -import Test.Web.UCAN.Prelude +import Test.Prelude import Web.UCAN.Proof.Class From de68f1c3c8bac1db9a8240dcb16d4e43d27084f6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Fri, 21 Jan 2022 17:08:33 +0100 Subject: [PATCH 02/19] Write failing rsa DID test --- hs-ucan/test/Test/Web/DID.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/hs-ucan/test/Test/Web/DID.hs b/hs-ucan/test/Test/Web/DID.hs index ab9b79f29..f09597a7e 100644 --- a/hs-ucan/test/Test/Web/DID.hs +++ b/hs-ucan/test/Test/Web/DID.hs @@ -55,6 +55,12 @@ spec = `shouldBe` Success (Right False) + describe "RSA" do + it "parses" $ + JSON.fromJSON @DID (JSON.String rsaDIDEncoded) `shouldSatisfy` \case + Success _ -> True + Error _ -> False + runSignatureTest :: Alg.Algorithm -> Text -> ByteString -> Text -> JSON.Result (Either Signature.Error Bool) runSignatureTest alg didEncoded signedData sigEncoded = @@ -87,3 +93,6 @@ bobDIDEncoded = "did:key:z6MkffDZCkCTWreg8868fG1FGFogcJj5X6PY93pPcWDn9bob" bobHelloWorldSignature :: Text bobHelloWorldSignature = "PV9pjuzha64gVXCUHghTN3aa6r1lKFOdmH4OJPshDBEgqATA06jWojW377RQQClOyWqRmaNkjQ93UyJvteP9Cg" + +rsaDIDEncoded :: Text +rsaDIDEncoded = "did:key:z4MXj1wBzi9jUstyNvmiK5WLRRL4rr9UvzPxhry1CudCLKWLyMbP1WoTwDfttBTpxDKf5hAJEjqNbeYx2EEvrJmSWHAu7TJRPTrE3QodbMfRvRNRDyYvaN1FSQus2ziS1rWXwAi5Gpc16bY3JwjyLCPJLfdRWHZhRXiay5FWEkfoSKy6aftnzAvqNkKBg2AxgzGMinR6d1WiH4w5mEXFtUeZkeo4uwtRTd8rD9BoVaHVkGwJkksDybE23CsBNXiNfbweFVRcwfTMhcQsTsYhUWDcSC6QE3zt9h4Rsrj7XRYdwYSK5bc1qFRsg5HULKBp2uZ1gcayiW2FqHFcMRjBieC4LnSMSD1AZB1WUncVRbPpVkn1UGhCU" From 0b63acabe5fc9dbedc5b6d0d7008aeacfade9aab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Mon, 24 Jan 2022 12:04:49 +0100 Subject: [PATCH 03/19] Move over DID tests --- fission-core/test/Fission/Test/User/DID.hs | 84 ------------------- hs-ucan/test/Test/Web/DID.hs | 96 +++++++++++++++++++++- 2 files changed, 94 insertions(+), 86 deletions(-) delete mode 100644 fission-core/test/Fission/Test/User/DID.hs diff --git a/fission-core/test/Fission/Test/User/DID.hs b/fission-core/test/Fission/Test/User/DID.hs deleted file mode 100644 index a48f1aae4..000000000 --- a/fission-core/test/Fission/Test/User/DID.hs +++ /dev/null @@ -1,84 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} - -module Fission.Test.User.DID (spec) where - -import qualified Crypto.PubKey.Ed25519 as Ed25519 -import qualified Data.Aeson as JSON - -import qualified RIO.ByteString.Lazy as Lazy -import Servant.API - -import Crypto.Key.Asymmetric as Key -import Web.DID.Oldstyle.Types -import Web.DID.Types - -import Fission.Test.Prelude - -spec :: Spec -spec = - describe "Serialization" do - context "RSA2048" do - it "serializes to a well-known value" - let - expected :: Lazy.ByteString - expected = "did:key:z13V3Sog2YaUKhdGCmgx9UZuW1o1ShFJYc6DvGYe7NTt689NoL2RtpVs65Zw899YrTN9WuxdEEDm54YxWuQHQvcKfkZwa8HTgokHxGDPEmNLhvh69zUMEP4zjuARQ3T8bMUumkSLGpxNe1bfQX624ef45GhWb3S9HM3gvAJ7Qftm8iqnDQVcxwKHjmkV4hveKMTix4bTRhieVHi1oqU4QCVy4QPWpAAympuCP9dAoJFxSP6TNBLY9vPKLazsg7XcFov6UuLWsEaxJ5SomCpDx181mEgW2qTug5oQbrJwExbD9CMgXHLVDE2QgLoQMmgsrPevX57dH715NXC2uY6vo2mYCzRY4KuDRUsrkuYCkewL8q2oK1BEDVvi3Sg8pbC9QYQ5mMiHf8uxiHxTAmPedv8" - in - encode (DID Key rsaKey) `shouldBe` "\"" <> expected <> "\"" - - context "Ed25519" do - it "serializes to a well-known value" - let - expected :: Text - expected = "did:key:z6MkgYGF3thn8k1Fv4p4dWXKtsXCnLH7q9yw4QgNPULDmDKB" - in - encode (DID Key edKey) `shouldBe` JSON.encode expected - - itsProp' "deserialize . serialize ~ id" \(ed25519pk :: Ed25519.PublicKey) -> - decode (encode . DID Key $ Ed25519PublicKey ed25519pk) `shouldBe` - Just (DID Key $ Ed25519PublicKey ed25519pk) - - itsProp' "lengths is always 56" \(ed25519pk :: Ed25519.PublicKey) -> - Lazy.length (encode . DID Key $ Ed25519PublicKey ed25519pk) `shouldBe` 56 + 2 -- extra 2 for quotes because JSON - - itsProp' "always starts with 'did:key:z6Mk'" \(ed25519pk :: Ed25519.PublicKey) -> - Lazy.take 13 (encode . DID Key $ Ed25519PublicKey ed25519pk) `shouldBe` "\"did:key:z6Mk" - - context "Legacy (AKA `Oldstyle`)" do - it "deserializes to a well-known value" $ - eitherDecodeStrict ("\"" <> encodeUtf8 oldstyle <> "\"") - `shouldBe` Right (DID Key edKey) - - it "can be manually set to display in the Oldstyle format" $ - textDisplay Oldstyle { did = DID Key edKey } `shouldBe` oldstyle - - context "W3C did:key Ed25519 test vectors" do - didKeyTestVectors |> foldMapM \(idx, bs) -> - it ("Deserializes vector #" <> show idx <> " to a valid DID") $ - eitherDecode (encode bs) `shouldSatisfy` isEd25519DidKey - - itsProp' "serialized is isomorphic to ADT" \(did :: DID) -> - JSON.decode (JSON.encode did) `shouldBe` Just did - - itsProp' "is a base58 encoded Key DID" \(did :: DID) -> - Lazy.isPrefixOf "\"did:key:z" (JSON.encode did) - -rsaKey :: Key.Public -Right rsaKey = parseUrlPiece "MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAnzyis1ZjfNB0bBgKFMSvvkTtwlvBsaJq7S5wA+kzeVOVpVWwkWdVha4s38XM/pa/yr47av7+z3VTmvDRyAHcaT92whREFpLv9cj5lTeJSibyr/Mrm/YtjCZVWgaOYIhwrXwKLqPr/11inWsAkfIytvHWTxZYEcXLgAXFuUuaS3uF9gEiNQwzGTU1v0FqkqTBr4B8nW3HCN47XUu0t8Y0e+lf4s4OxQawWD79J9/5d3Ry0vbV3Am1FtGJiJvOwRsIfVChDpYStTcHTCMqtvWbV6L11BWkpzGXSW4Hv43qa+GSYOD2QU68Mb59oSk2OB+BtOLpJofmbGEGgvmwyCI9MwIDAQAB" - -edKey :: Key.Public -Right edKey = parseUrlPiece "Hv+AVRD2WUjUFOsSNbsmrp9fokuwrUnjBcr92f0kxw4=" - -isEd25519DidKey :: Either String DID -> Bool -isEd25519DidKey = \case - Right (DID Key (Ed25519PublicKey _)) -> True - _ -> False - -didKeyTestVectors :: [(Natural, Text)] -didKeyTestVectors = - [ (0, "did:key:z6MkiTBz1ymuepAQ4HEHYSF1H8quG5GLVVQR3djdX3mDooWp") - , (1, "did:key:z6MkjchhfUsD6mmvni8mCdXHw216Xrm9bQe2mBH1P5RDjVJG") - , (2, "did:key:z6MknGc3ocHs3zdPiJbnaaqDi58NGb4pk1Sp9WxWufuXSdxf") - ] - -oldstyle :: Text -oldstyle = "did:key:zStEZpzSMtTt9k2vszgvCwF4fLQQSyA15W5AQ4z3AR6Bx4eFJ5crJFbuGxKmbma4" diff --git a/hs-ucan/test/Test/Web/DID.hs b/hs-ucan/test/Test/Web/DID.hs index f09597a7e..d1a9934ff 100644 --- a/hs-ucan/test/Test/Web/DID.hs +++ b/hs-ucan/test/Test/Web/DID.hs @@ -1,13 +1,21 @@ +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module Test.Web.DID (spec) where import Data.Aeson as JSON import qualified Data.Aeson.Types as JSON -import Web.DID.Types as DID +import Servant.API + +import qualified RIO.ByteString.Lazy as Lazy +import Crypto.Key.Asymmetric as Key import qualified Crypto.Key.Asymmetric.Algorithm.Types as Alg +import qualified Crypto.PubKey.Ed25519 as Ed25519 import Test.Prelude + +import Web.DID.Oldstyle.Types +import Web.DID.Types as DID import qualified Web.DID.Verification as DID import qualified Web.UCAN.Signature as Signature import qualified Web.UCAN.Signature.Error as Signature @@ -17,12 +25,53 @@ spec :: Spec spec = describe "DID" do describe "serialisation" do + describe "RSA2048" do + it "serializes to a well-known value" + let + expected :: Lazy.ByteString + expected = "did:key:z13V3Sog2YaUKhdGCmgx9UZuW1o1ShFJYc6DvGYe7NTt689NoL2RtpVs65Zw899YrTN9WuxdEEDm54YxWuQHQvcKfkZwa8HTgokHxGDPEmNLhvh69zUMEP4zjuARQ3T8bMUumkSLGpxNe1bfQX624ef45GhWb3S9HM3gvAJ7Qftm8iqnDQVcxwKHjmkV4hveKMTix4bTRhieVHi1oqU4QCVy4QPWpAAympuCP9dAoJFxSP6TNBLY9vPKLazsg7XcFov6UuLWsEaxJ5SomCpDx181mEgW2qTug5oQbrJwExbD9CMgXHLVDE2QgLoQMmgsrPevX57dH715NXC2uY6vo2mYCzRY4KuDRUsrkuYCkewL8q2oK1BEDVvi3Sg8pbC9QYQ5mMiHf8uxiHxTAmPedv8" + in + encode (DID Key rsaKey) `shouldBe` "\"" <> expected <> "\"" + + describe "Ed25519" do + it "serializes to a well-known value" + let + expected :: Text + expected = "did:key:z6MkgYGF3thn8k1Fv4p4dWXKtsXCnLH7q9yw4QgNPULDmDKB" + in + encode (DID Key edKey) `shouldBe` JSON.encode expected + + itsProp' "deserialize . serialize ~ id" \(ed25519pk :: Ed25519.PublicKey) -> + decode (encode . DID Key $ Ed25519PublicKey ed25519pk) `shouldBe` + Just (DID Key $ Ed25519PublicKey ed25519pk) + + itsProp' "lengths is always 56" \(ed25519pk :: Ed25519.PublicKey) -> + Lazy.length (encode . DID Key $ Ed25519PublicKey ed25519pk) `shouldBe` 56 + 2 -- extra 2 for quotes because JSON + + itsProp' "always starts with 'did:key:z6Mk'" \(ed25519pk :: Ed25519.PublicKey) -> + Lazy.take 13 (encode . DID Key $ Ed25519PublicKey ed25519pk) `shouldBe` "\"did:key:z6Mk" + + describe "Legacy (AKA `Oldstyle`)" do + it "deserializes to a well-known value" $ + eitherDecodeStrict ("\"" <> encodeUtf8 oldstyleEdKey <> "\"") + `shouldBe` Right (DID Key edKey) + + it "can be manually set to display in the Oldstyle format" $ + textDisplay Oldstyle { did = DID Key edKey } `shouldBe` oldstyleEdKey + + itsProp' "serialized is isomorphic to ADT" \(did :: DID) -> + JSON.decode (JSON.encode did) `shouldBe` Just did + + itsProp' "is a base58 encoded Key DID" \(did :: DID) -> + Lazy.isPrefixOf "\"did:key:z" (JSON.encode did) + itsProp' "seralized is isomorphic to ADT" \(did :: DID) -> JSON.eitherDecode (JSON.encode did) `shouldBe` Right did describe "fixtures" do describe "Ed25519" do + it "verifies alice's signature" do runSignatureTest Alg.Ed25519 aliceDIDEncoded @@ -55,12 +104,22 @@ spec = `shouldBe` Success (Right False) + describe "W3C did:key test vectors" do + testVectorsW3CEdKey & foldMapM \(idx, bs) -> + it ("Deserializes vector #" <> show idx <> " to a valid DID") $ + eitherDecode (encode bs) `shouldSatisfy` isEd25519DidKey + describe "RSA" do - it "parses" $ + it "parses a ts-ucan-generated RSA DID" $ JSON.fromJSON @DID (JSON.String rsaDIDEncoded) `shouldSatisfy` \case Success _ -> True Error _ -> False + describe "W3C did:key test vectors" do + testVectorsW3CRSA & foldMapM \(idx, bs) -> + it ("Deserializes vector #" <> show idx <> " to a valid DID") $ + eitherDecode (encode bs) `shouldSatisfy` isRSADidKey + runSignatureTest :: Alg.Algorithm -> Text -> ByteString -> Text -> JSON.Result (Either Signature.Error Bool) runSignatureTest alg didEncoded signedData sigEncoded = @@ -96,3 +155,36 @@ bobHelloWorldSignature = "PV9pjuzha64gVXCUHghTN3aa6r1lKFOdmH4OJPshDBEgqATA06jWoj rsaDIDEncoded :: Text rsaDIDEncoded = "did:key:z4MXj1wBzi9jUstyNvmiK5WLRRL4rr9UvzPxhry1CudCLKWLyMbP1WoTwDfttBTpxDKf5hAJEjqNbeYx2EEvrJmSWHAu7TJRPTrE3QodbMfRvRNRDyYvaN1FSQus2ziS1rWXwAi5Gpc16bY3JwjyLCPJLfdRWHZhRXiay5FWEkfoSKy6aftnzAvqNkKBg2AxgzGMinR6d1WiH4w5mEXFtUeZkeo4uwtRTd8rD9BoVaHVkGwJkksDybE23CsBNXiNfbweFVRcwfTMhcQsTsYhUWDcSC6QE3zt9h4Rsrj7XRYdwYSK5bc1qFRsg5HULKBp2uZ1gcayiW2FqHFcMRjBieC4LnSMSD1AZB1WUncVRbPpVkn1UGhCU" + + +rsaKey :: Key.Public +Right rsaKey = parseUrlPiece "MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAnzyis1ZjfNB0bBgKFMSvvkTtwlvBsaJq7S5wA+kzeVOVpVWwkWdVha4s38XM/pa/yr47av7+z3VTmvDRyAHcaT92whREFpLv9cj5lTeJSibyr/Mrm/YtjCZVWgaOYIhwrXwKLqPr/11inWsAkfIytvHWTxZYEcXLgAXFuUuaS3uF9gEiNQwzGTU1v0FqkqTBr4B8nW3HCN47XUu0t8Y0e+lf4s4OxQawWD79J9/5d3Ry0vbV3Am1FtGJiJvOwRsIfVChDpYStTcHTCMqtvWbV6L11BWkpzGXSW4Hv43qa+GSYOD2QU68Mb59oSk2OB+BtOLpJofmbGEGgvmwyCI9MwIDAQAB" + +edKey :: Key.Public +Right edKey = parseUrlPiece "Hv+AVRD2WUjUFOsSNbsmrp9fokuwrUnjBcr92f0kxw4=" + +isEd25519DidKey :: Either String DID -> Bool +isEd25519DidKey = \case + Right (DID Key (Ed25519PublicKey _)) -> True + _ -> False + +isRSADidKey :: Either String DID -> Bool +isRSADidKey = \case + Right (DID Key (RSAPublicKey _)) -> True + _ -> False + +testVectorsW3CEdKey :: [(Natural, Text)] +testVectorsW3CEdKey = + [ (0, "did:key:z6MkiTBz1ymuepAQ4HEHYSF1H8quG5GLVVQR3djdX3mDooWp") + , (1, "did:key:z6MkjchhfUsD6mmvni8mCdXHw216Xrm9bQe2mBH1P5RDjVJG") + , (2, "did:key:z6MknGc3ocHs3zdPiJbnaaqDi58NGb4pk1Sp9WxWufuXSdxf") + ] + +testVectorsW3CRSA :: [(Natural, Text)] +testVectorsW3CRSA = + [ (0, "did:key:z4MXj1wBzi9jUstyPMS4jQqB6KdJaiatPkAtVtGc6bQEQEEsKTic4G7Rou3iBf9vPmT5dbkm9qsZsuVNjq8HCuW1w24nhBFGkRE4cd2Uf2tfrB3N7h4mnyPp1BF3ZttHTYv3DLUPi1zMdkULiow3M1GfXkoC6DoxDUm1jmN6GBj22SjVsr6dxezRVQc7aj9TxE7JLbMH1wh5X3kA58H3DFW8rnYMakFGbca5CB2Jf6CnGQZmL7o5uJAdTwXfy2iiiyPxXEGerMhHwhjTA1mKYobyk2CpeEcmvynADfNZ5MBvcCS7m3XkFCMNUYBS9NQ3fze6vMSUPsNa6GVYmKx2x6JrdEjCk3qRMMmyjnjCMfR4pXbRMZa3i" ) + , (1, "did:key:zgghBUVkqmWS8e1ioRVp2WN9Vw6x4NvnE9PGAyQsPqM3fnfPf8EdauiRVfBTcVDyzhqM5FFC7ekAvuV1cJHawtfgB9wDcru1hPDobk3hqyedijhgWmsYfJCmodkiiFnjNWATE7PvqTyoCjcmrc8yMRXmFPnoASyT5beUd4YZxTE9VfgmavcPy3BSouNmASMQ8xUXeiRwjb7xBaVTiDRjkmyPD7NYZdXuS93gFhyDFr5b3XLg7Rfj9nHEqtHDa7NmAX7iwDAbMUFEfiDEf9hrqZmpAYJracAjTTR8Cvn6mnDXMLwayNG8dcsXFodxok2qksYF4D8ffUxMRmyyQVQhhhmdSi4YaMPqTnC1J6HTG9Yfb98yGSVaWi4TApUhLXFow2ZvB6vqckCNhjCRL2R4MDUSk71qzxWHgezKyDeyThJgdxydrn1osqH94oSeA346eipkJvKqYREXBKwgB5VL6WF4qAK6sVZxJp2dQBfCPVZ4EbsBQaJXaVK7cNcWG8tZBFWZ79gG9Cu6C4u8yjBS8Ux6dCcJPUTLtixQu4z2n5dCsVSNdnP1EEs8ZerZo5pBgc68w4Yuf9KL3xVxPnAB1nRCBfs9cMU6oL1EdyHbqrTfnjE8HpY164akBqe92LFVsk8RusaGsVPrMekT8emTq5y8v8CabuZg5rDs3f9NPEtogjyx49wiub1FecM5B7QqEcZSYiKHgF4mfkteT2" ) + ] + +oldstyleEdKey :: Text +oldstyleEdKey = "did:key:zStEZpzSMtTt9k2vszgvCwF4fLQQSyA15W5AQ4z3AR6Bx4eFJ5crJFbuGxKmbma4" From e74f98d10d38b9a499c2808366cb6d1f50f55937 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Mon, 24 Jan 2022 12:26:26 +0100 Subject: [PATCH 04/19] Manually import core changes from ##550 --- .../Crypto/Key/Asymmetric/Public/Types.hs | 4 +- hs-ucan/library/Web/DID/Method/Types.hs | 23 ----------- hs-ucan/library/Web/DID/Oldstyle/Types.hs | 5 +-- hs-ucan/library/Web/DID/Types.hs | 38 +++++++------------ hs-ucan/library/Web/DID/Verification.hs | 4 +- .../UCAN/Internal/Orphanage/RSA2048/Public.hs | 22 ++++------- hs-ucan/library/Web/UCAN/Types.hs | 10 ++--- hs-ucan/library/Web/UCAN/Validation.hs | 6 +-- hs-ucan/test/Main.hs | 4 +- hs-ucan/test/Test/Web/DID.hs | 20 +++++----- hs-ucan/test/Test/Web/UCAN/Example.hs | 2 +- 11 files changed, 48 insertions(+), 90 deletions(-) delete mode 100644 hs-ucan/library/Web/DID/Method/Types.hs diff --git a/hs-ucan/library/Crypto/Key/Asymmetric/Public/Types.hs b/hs-ucan/library/Crypto/Key/Asymmetric/Public/Types.hs index 6f24e2e38..5264f1130 100644 --- a/hs-ucan/library/Crypto/Key/Asymmetric/Public/Types.hs +++ b/hs-ucan/library/Crypto/Key/Asymmetric/Public/Types.hs @@ -24,7 +24,9 @@ data Public deriving Eq instance Show Public where - show = Text.unpack . textDisplay + show = \case + Ed25519PublicKey ed -> Text.unpack $ textDisplay ed + RSAPublicKey pk -> show pk instance Display Public where textDisplay (Ed25519PublicKey pk) = textDisplay pk diff --git a/hs-ucan/library/Web/DID/Method/Types.hs b/hs-ucan/library/Web/DID/Method/Types.hs deleted file mode 100644 index a59d8d5a7..000000000 --- a/hs-ucan/library/Web/DID/Method/Types.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Web.DID.Method.Types (Method (..)) where - -import Data.Aeson -import RIO -import Test.QuickCheck - -data Method - = Key - deriving (Show, Eq) - -instance Display Method where - display Key = "key" - -instance Arbitrary Method where - arbitrary = elements [Key] - -instance ToJSON Method where - toJSON Key = "key" - -instance FromJSON Method where - parseJSON = withText "DID.Method" \case - "key" -> return Key - other -> fail $ show other <> " is not an acceptable DID method" diff --git a/hs-ucan/library/Web/DID/Oldstyle/Types.hs b/hs-ucan/library/Web/DID/Oldstyle/Types.hs index f12127b81..cdc61dd6c 100644 --- a/hs-ucan/library/Web/DID/Oldstyle/Types.hs +++ b/hs-ucan/library/Web/DID/Oldstyle/Types.hs @@ -7,8 +7,7 @@ import qualified RIO.ByteString as BS import qualified Web.UCAN.Internal.UTF8 as UTF8 import Crypto.Key.Asymmetric as Key -import Web.DID.Method.Types -import Web.DID.Types +import Web.DID.Types as DID -- | DEPRECATED Encoding of oldstyle Ed25519 DIDs. Manual use only @@ -16,7 +15,7 @@ newtype Oldstyle = Oldstyle { did :: DID } deriving stock (Show, Eq) instance Display Oldstyle where - textDisplay Oldstyle {did = DID Key (Ed25519PublicKey ed)} = + textDisplay Oldstyle {did = DID.Key (Ed25519PublicKey ed)} = mconcat [ "did:key:z" , UTF8.toBase58Text $ BS.pack (0xed : 0x01 : BS.unpack (encodeUtf8 $ textDisplay ed)) diff --git a/hs-ucan/library/Web/DID/Types.hs b/hs-ucan/library/Web/DID/Types.hs index fed6302b5..73ffe81f4 100644 --- a/hs-ucan/library/Web/DID/Types.hs +++ b/hs-ucan/library/Web/DID/Types.hs @@ -1,7 +1,5 @@ module Web.DID.Types ( DID (..) - -- * Reexport - , module Web.DID.Method.Types ) where import Data.Aeson as JSON @@ -15,6 +13,7 @@ import Data.Base58String.Bitcoin as BS58.BTC import Data.Binary hiding (encode) import qualified Data.ByteArray as BA import qualified Data.ByteString.Base64 as BS64 +import qualified Data.ByteString.Builder as Builder import Data.Hashable (Hashable (..)) import Crypto.Error @@ -22,6 +21,7 @@ import qualified Crypto.PubKey.Ed25519 as Ed25519 import RIO import qualified RIO.ByteString as BS +import qualified RIO.ByteString.Lazy as Lazy import qualified RIO.Text as Text import qualified Web.UCAN.Internal.UTF8 as UTF8 @@ -29,7 +29,6 @@ import qualified Web.UCAN.Internal.UTF8 as UTF8 import Servant.API import Crypto.Key.Asymmetric as Key (Public (..)) -import Web.DID.Method.Types {- | A DID key, broken into its constituant parts @@ -75,21 +74,17 @@ RSA Right (DID {method = Key, publicKey = MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAnzyis1ZjfNB0bBgKFMSvvkTtwlvBsaJq7S5wA+kzeVOVpVWwkWdVha4s38XM/pa/yr47av7+z3VTmvDRyAHcaT92whREFpLv9cj5lTeJSibyr/Mrm/YtjCZVWgaOYIhwrXwKLqPr/11inWsAkfIytvHWTxZYEcXLgAXFuUuaS3uF9gEiNQwzGTU1v0FqkqTBr4B8nW3HCN47XUu0t8Y0e+lf4s4OxQawWD79J9/5d3Ry0vbV3Am1FtGJiJvOwRsIfVChDpYStTcHTCMqtvWbV6L11BWkpzGXSW4Hv43qa+GSYOD2QU68Mb59oSk2OB+BtOLpJofmbGEGgvmwyCI9MwIDAQAB}) -} -data DID = DID - { method :: Method - , publicKey :: Key.Public - } deriving (Show, Eq) +data DID + = Key Key.Public + -- More varieties here later + deriving (Show, Eq) -- For FromJSON instance Ord DID where a `compare` b = textDisplay a `compare` textDisplay b instance Arbitrary DID where - arbitrary = do - publicKey <- arbitrary - method <- arbitrary - - return DID {..} + arbitrary = Key <$> arbitrary instance Hashable DID where hashWithSalt salt did = hashWithSalt salt $ textDisplay did @@ -107,21 +102,16 @@ instance FromHttpApiData DID where Right val -> Right val instance Display DID where -- NOTE `pk` here is base2, not base58 - textDisplay (DID method pk) = header <> UTF8.toBase58Text (BS.pack multicodecW8) + textDisplay (Key pk) = "did:key:z" <> UTF8.toBase58Text (BS.pack multicodecW8) where - header :: Text - header = "did:" <> textDisplay method <> ":" <> "z" - multicodecW8 :: [Word8] multicodecW8 = case pk of - Ed25519PublicKey ed -> 0xed : 0x01 : BS.unpack (BA.convert ed) - RSAPublicKey rsa -> 0x00 : 0xF5 : 0x02 : BS.unpack (BS64.decodeLenient . encodeUtf8 $ textDisplay rsa) - {- ^ ^ ^ - | | | - | "expect 373 Bytes", encoded in the mixed-endian format - "raw" - -} + Ed25519PublicKey ed -> + 0xed : 0x01 : BS.unpack (BA.convert ed) + + RSAPublicKey rsa -> + 0x12 : 0x05 : BS.unpack (Lazy.toStrict . Builder.toLazyByteString . getUtf8Builder $ display rsa) instance ToJSON DID where toJSON = String . textDisplay @@ -163,4 +153,4 @@ parseText txt = nope -> fail . show . BS64.encode $ BS.pack nope <> " is not an acceptable did:key" - return $ DID Key pk + return $ Key pk diff --git a/hs-ucan/library/Web/DID/Verification.hs b/hs-ucan/library/Web/DID/Verification.hs index 02feaaade..2e5817dc2 100644 --- a/hs-ucan/library/Web/DID/Verification.hs +++ b/hs-ucan/library/Web/DID/Verification.hs @@ -8,14 +8,14 @@ import qualified Crypto.PubKey.Ed25519 import qualified Crypto.PubKey.RSA.PKCS15 import RIO -import Web.DID.Types +import Web.DID.Types as DID import qualified Web.UCAN.Signature.Error as Signature import qualified Web.UCAN.Signature.RS256.Types as RSA import Web.UCAN.Signature.Types as Signature verifySignature :: DID -> ByteString -> Signature -> Either Signature.Error Bool -verifySignature DID{ publicKey } signedData signature = +verifySignature (DID.Key publicKey) signedData signature = case (publicKey, signature) of (Key.Ed25519PublicKey pk, Signature.Ed25519 sig) -> Right $ Crypto.PubKey.Ed25519.verify pk signedData sig diff --git a/hs-ucan/library/Web/UCAN/Internal/Orphanage/RSA2048/Public.hs b/hs-ucan/library/Web/UCAN/Internal/Orphanage/RSA2048/Public.hs index b7fb2d94f..4f08db004 100644 --- a/hs-ucan/library/Web/UCAN/Internal/Orphanage/RSA2048/Public.hs +++ b/hs-ucan/library/Web/UCAN/Internal/Orphanage/RSA2048/Public.hs @@ -14,6 +14,7 @@ import qualified Data.ASN1.Types as ASN1 import qualified Data.PEM as PEM import qualified Data.ByteString.Base64 as BS64 +import qualified Data.ByteString.Builder as Builder import qualified Data.X509 as X509 import Data.Swagger @@ -35,15 +36,14 @@ instance Arbitrary RSA.PublicKey where return . fst . Unsafe.unsafePerformIO $ RSA.generate 2048 exp instance Display RSA.PublicKey where - textDisplay pk = - X509.PubKeyRSA pk + display pk = + pk + & X509.PubKeyRSA & X509.pubKeyToPEM - & PEM.pemWriteBS - & decodeUtf8Lenient - & Text.strip - & Text.dropPrefix pemHeader - & Text.dropSuffix pemFooter - & Text.filter (/= '\n') + & PEM.pemContent + & BS64.decodeLenient + & Builder.byteString + & Utf8Builder instance ToHttpApiData RSA.PublicKey where toUrlPiece = textDisplay @@ -83,9 +83,3 @@ instance ToSchema RSA.PublicKey where & description ?~ "An RSA public key" & NamedSchema (Just "RSA.PublicKey") & pure - -pemHeader :: Text -pemHeader = "-----BEGIN PUBLIC KEY-----" - -pemFooter :: Text -pemFooter = "-----END PUBLIC KEY-----" diff --git a/hs-ucan/library/Web/UCAN/Types.hs b/hs-ucan/library/Web/UCAN/Types.hs index 284b40d0b..2ba8f6651 100644 --- a/hs-ucan/library/Web/UCAN/Types.hs +++ b/hs-ucan/library/Web/UCAN/Types.hs @@ -42,7 +42,7 @@ import Test.QuickCheck import Crypto.Key.Asymmetric as Key import qualified Crypto.Key.Asymmetric.Algorithm.Types as Algorithm -import Web.DID.Types +import Web.DID.Types as DID import Web.UCAN.Header.Types (Header (..)) import qualified Web.UCAN.RawContent as UCAN @@ -93,7 +93,7 @@ instance claims' <- arbitrary let - claims = claims' {sender = DID Key pk} + claims = claims' {sender = DID.Key pk} sig' = case sk of Left rsaSK -> Unsafe.unsafePerformIO $ signRS256 header claims rsaSK @@ -197,11 +197,7 @@ instance nbf <- arbitrary pk <- arbitrary - let - receiver = DID - { publicKey = pk - , method = Key - } + let receiver = DID.Key pk return Claims {..} diff --git a/hs-ucan/library/Web/UCAN/Validation.hs b/hs-ucan/library/Web/UCAN/Validation.hs index d8716b057..0985ce1e8 100644 --- a/hs-ucan/library/Web/UCAN/Validation.hs +++ b/hs-ucan/library/Web/UCAN/Validation.hs @@ -20,7 +20,7 @@ import Data.Aeson import Control.Monad.Time import Crypto.Key.Asymmetric as Key -import Web.DID.Types as User +import Web.DID.Types as DID import Web.SemVer.Types import Web.UCAN.Resolver as Proof @@ -161,7 +161,7 @@ checkRSA2048Signature (UCAN.RawContent raw) ucan@UCAN {..} (RS256.Signature inne where content = encodeUtf8 raw - Claims {sender = User.DID {publicKey}} = claims + Claims {sender = DID.Key publicKey} = claims checkEd25519Signature :: UCAN.RawContent -> UCAN fct rsc ptc -> Either UCAN.Error (UCAN fct rsc ptc) checkEd25519Signature (UCAN.RawContent raw) ucan@UCAN {..} = @@ -175,4 +175,4 @@ checkEd25519Signature (UCAN.RawContent raw) ucan@UCAN {..} = Left $ UCAN.SignatureError InvalidPublicKey where - Claims {sender = User.DID {publicKey}} = claims + Claims {sender = DID.Key publicKey} = claims diff --git a/hs-ucan/test/Main.hs b/hs-ucan/test/Main.hs index eb2cda92d..570b3fd97 100644 --- a/hs-ucan/test/Main.hs +++ b/hs-ucan/test/Main.hs @@ -2,8 +2,8 @@ module Main (main) where import Test.Prelude -import qualified Test.Web.UCAN as UCAN -import qualified Test.Web.DID as DID +import qualified Test.Web.DID as DID +import qualified Test.Web.UCAN as UCAN main :: IO () diff --git a/hs-ucan/test/Test/Web/DID.hs b/hs-ucan/test/Test/Web/DID.hs index d1a9934ff..41d37cf20 100644 --- a/hs-ucan/test/Test/Web/DID.hs +++ b/hs-ucan/test/Test/Web/DID.hs @@ -31,7 +31,7 @@ spec = expected :: Lazy.ByteString expected = "did:key:z13V3Sog2YaUKhdGCmgx9UZuW1o1ShFJYc6DvGYe7NTt689NoL2RtpVs65Zw899YrTN9WuxdEEDm54YxWuQHQvcKfkZwa8HTgokHxGDPEmNLhvh69zUMEP4zjuARQ3T8bMUumkSLGpxNe1bfQX624ef45GhWb3S9HM3gvAJ7Qftm8iqnDQVcxwKHjmkV4hveKMTix4bTRhieVHi1oqU4QCVy4QPWpAAympuCP9dAoJFxSP6TNBLY9vPKLazsg7XcFov6UuLWsEaxJ5SomCpDx181mEgW2qTug5oQbrJwExbD9CMgXHLVDE2QgLoQMmgsrPevX57dH715NXC2uY6vo2mYCzRY4KuDRUsrkuYCkewL8q2oK1BEDVvi3Sg8pbC9QYQ5mMiHf8uxiHxTAmPedv8" in - encode (DID Key rsaKey) `shouldBe` "\"" <> expected <> "\"" + encode (DID.Key rsaKey) `shouldBe` "\"" <> expected <> "\"" describe "Ed25519" do it "serializes to a well-known value" @@ -39,25 +39,25 @@ spec = expected :: Text expected = "did:key:z6MkgYGF3thn8k1Fv4p4dWXKtsXCnLH7q9yw4QgNPULDmDKB" in - encode (DID Key edKey) `shouldBe` JSON.encode expected + encode (DID.Key edKey) `shouldBe` JSON.encode expected itsProp' "deserialize . serialize ~ id" \(ed25519pk :: Ed25519.PublicKey) -> - decode (encode . DID Key $ Ed25519PublicKey ed25519pk) `shouldBe` - Just (DID Key $ Ed25519PublicKey ed25519pk) + decode (encode . DID.Key $ Ed25519PublicKey ed25519pk) `shouldBe` + Just (DID.Key $ Ed25519PublicKey ed25519pk) itsProp' "lengths is always 56" \(ed25519pk :: Ed25519.PublicKey) -> - Lazy.length (encode . DID Key $ Ed25519PublicKey ed25519pk) `shouldBe` 56 + 2 -- extra 2 for quotes because JSON + Lazy.length (encode . DID.Key $ Ed25519PublicKey ed25519pk) `shouldBe` 56 + 2 -- extra 2 for quotes because JSON itsProp' "always starts with 'did:key:z6Mk'" \(ed25519pk :: Ed25519.PublicKey) -> - Lazy.take 13 (encode . DID Key $ Ed25519PublicKey ed25519pk) `shouldBe` "\"did:key:z6Mk" + Lazy.take 13 (encode . DID.Key $ Ed25519PublicKey ed25519pk) `shouldBe` "\"did:key:z6Mk" describe "Legacy (AKA `Oldstyle`)" do it "deserializes to a well-known value" $ eitherDecodeStrict ("\"" <> encodeUtf8 oldstyleEdKey <> "\"") - `shouldBe` Right (DID Key edKey) + `shouldBe` Right (DID.Key edKey) it "can be manually set to display in the Oldstyle format" $ - textDisplay Oldstyle { did = DID Key edKey } `shouldBe` oldstyleEdKey + textDisplay Oldstyle { did = DID.Key edKey } `shouldBe` oldstyleEdKey itsProp' "serialized is isomorphic to ADT" \(did :: DID) -> JSON.decode (JSON.encode did) `shouldBe` Just did @@ -165,12 +165,12 @@ Right edKey = parseUrlPiece "Hv+AVRD2WUjUFOsSNbsmrp9fokuwrUnjBcr92f0kxw4=" isEd25519DidKey :: Either String DID -> Bool isEd25519DidKey = \case - Right (DID Key (Ed25519PublicKey _)) -> True + Right (DID.Key (Ed25519PublicKey _)) -> True _ -> False isRSADidKey :: Either String DID -> Bool isRSADidKey = \case - Right (DID Key (RSAPublicKey _)) -> True + Right (DID.Key (RSAPublicKey _)) -> True _ -> False testVectorsW3CEdKey :: [(Natural, Text)] diff --git a/hs-ucan/test/Test/Web/UCAN/Example.hs b/hs-ucan/test/Test/Web/UCAN/Example.hs index dbe369f5d..a403f8e6e 100644 --- a/hs-ucan/test/Test/Web/UCAN/Example.hs +++ b/hs-ucan/test/Test/Web/UCAN/Example.hs @@ -4,7 +4,7 @@ module Test.Web.UCAN.Example , Potency(..) ) where -import qualified RIO.Text as Text +import qualified RIO.Text as Text import Test.Prelude import Web.UCAN.Proof.Class From 3a11d683d2825fa1e5d643a61f8abb912ea6b0d4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Mon, 24 Jan 2022 12:28:14 +0100 Subject: [PATCH 05/19] Niv update --- nix/sources.json | 24 ++++++++++++------------ shell.nix | 3 --- 2 files changed, 12 insertions(+), 15 deletions(-) diff --git a/nix/sources.json b/nix/sources.json index 7c2f57068..90d507c81 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -5,10 +5,10 @@ "homepage": "", "owner": "NixOS", "repo": "nixpkgs", - "rev": "068984c00e0d4e54b6684d98f6ac47c92dcb642e", - "sha256": "00j4xv4lhhqwry7jd67brnws4pwb8vn660n43pvxpkalbpxszwfg", + "rev": "1c1f5649bb9c1b0d98637c8c365228f57126f361", + "sha256": "0f2nvdijyxfgl5kwyb4465pppd5vkhqxddx6v40k2s0z9jfhj0xl", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs/archive/068984c00e0d4e54b6684d98f6ac47c92dcb642e.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/1c1f5649bb9c1b0d98637c8c365228f57126f361.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "niv": { @@ -17,10 +17,10 @@ "homepage": "https://github.com/nmattia/niv", "owner": "nmattia", "repo": "niv", - "rev": "e0ca65c81a2d7a4d82a189f1e23a48d59ad42070", - "sha256": "1pq9nh1d8nn3xvbdny8fafzw87mj7gsmp6pxkdl65w2g18rmcmzx", + "rev": "5830a4dd348d77e39a0f3c4c762ff2663b602d4c", + "sha256": "1d3lsrqvci4qz2hwjrcnd8h5vfkg8aypq3sjd4g3izbc8frwz5sm", "type": "tarball", - "url": "https://github.com/nmattia/niv/archive/e0ca65c81a2d7a4d82a189f1e23a48d59ad42070.tar.gz", + "url": "https://github.com/nmattia/niv/archive/5830a4dd348d77e39a0f3c4c762ff2663b602d4c.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "nixos": { @@ -29,10 +29,10 @@ "homepage": "", "owner": "NixOS", "repo": "nixpkgs", - "rev": "8b0b81dab17753ab344a44c04be90a61dc55badf", - "sha256": "0rj17jpjxjcibcd4qygpxbq79m4px6b35nqq9353pns8w7a984xx", + "rev": "0fd9ee1aa36ce865ad273f4f07fdc093adeb5c00", + "sha256": "1mr2qgv5r2nmf6s3gqpcjj76zpsca6r61grzmqngwm0xlh958smx", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs/archive/8b0b81dab17753ab344a44c04be90a61dc55badf.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/0fd9ee1aa36ce865ad273f4f07fdc093adeb5c00.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "unstable": { @@ -41,10 +41,10 @@ "homepage": "", "owner": "NixOS", "repo": "nixpkgs", - "rev": "bbbe2b35f736d039884e082ecc6d6e631e126029", - "sha256": "09356lp9r1wx311ak6d94bx35xnvj8cabvwqirklylql8q7f52lc", + "rev": "689b76bcf36055afdeb2e9852f5ecdd2bf483f87", + "sha256": "08d38db4707jdm3gws82y6bynh6k8qal4s1cms9zqd9cdwcmylyj", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs/archive/bbbe2b35f736d039884e082ecc6d6e631e126029.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/689b76bcf36055afdeb2e9852f5ecdd2bf483f87.tar.gz", "url_template": "https://github.com///archive/.tar.gz" } } diff --git a/shell.nix b/shell.nix index 9aa4ac435..1c6c8a240 100644 --- a/shell.nix +++ b/shell.nix @@ -22,7 +22,6 @@ deps = { common = [ - pkgs.gnumake unstable.niv ]; @@ -43,8 +42,6 @@ ]; haskell = [ - unstable.ghc - unstable.haskellPackages.implicit-hie unstable.haskell-language-server unstable.stack unstable.stylish-haskell From c542e4356157fff39baf03c0f3880b58b6b82f91 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Mon, 24 Jan 2022 21:09:06 +0100 Subject: [PATCH 06/19] Remove redundant test --- fission-core/library/Fission/Internal/Orphanage/RSA2048.hs | 2 ++ hs-ucan/test/Test/Web/DID.hs | 3 --- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/fission-core/library/Fission/Internal/Orphanage/RSA2048.hs b/fission-core/library/Fission/Internal/Orphanage/RSA2048.hs index f3f6469ff..f485e9deb 100644 --- a/fission-core/library/Fission/Internal/Orphanage/RSA2048.hs +++ b/fission-core/library/Fission/Internal/Orphanage/RSA2048.hs @@ -7,5 +7,7 @@ import qualified System.IO.Unsafe as Unsafe import Fission.Prelude + +-- Wait. This is weird. How did this end up in this module? instance Arbitrary Ed25519.SecretKey where arbitrary = return . Unsafe.unsafePerformIO $ Ed25519.generateSecretKey diff --git a/hs-ucan/test/Test/Web/DID.hs b/hs-ucan/test/Test/Web/DID.hs index 41d37cf20..051a0bc7f 100644 --- a/hs-ucan/test/Test/Web/DID.hs +++ b/hs-ucan/test/Test/Web/DID.hs @@ -59,9 +59,6 @@ spec = it "can be manually set to display in the Oldstyle format" $ textDisplay Oldstyle { did = DID.Key edKey } `shouldBe` oldstyleEdKey - itsProp' "serialized is isomorphic to ADT" \(did :: DID) -> - JSON.decode (JSON.encode did) `shouldBe` Just did - itsProp' "is a base58 encoded Key DID" \(did :: DID) -> Lazy.isPrefixOf "\"did:key:z" (JSON.encode did) From 90297f8afca4aec93ccd4681f842b7756f3a4f2c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Tue, 25 Jan 2022 11:47:57 +0100 Subject: [PATCH 07/19] Parse ASN1 DER RSAPublicKeys --- .../library/Fission/Web/Auth/Token/UCAN.hs | 10 +--- .../library/Crypto/Key/Asymmetric/Public.hs | 52 ++++++++++++++++++- hs-ucan/library/Web/DID/Types.hs | 37 +++++++------ hs-ucan/test/Test/Web/DID.hs | 2 +- 4 files changed, 75 insertions(+), 26 deletions(-) diff --git a/fission-core/library/Fission/Web/Auth/Token/UCAN.hs b/fission-core/library/Fission/Web/Auth/Token/UCAN.hs index 985e1f425..01f463f5e 100644 --- a/fission-core/library/Fission/Web/Auth/Token/UCAN.hs +++ b/fission-core/library/Fission/Web/Auth/Token/UCAN.hs @@ -73,7 +73,7 @@ getRootDID :: -> m DID getRootDID fallbackPK = \case RootCredential -> - return $ DID Key fallbackPK + return $ DID.Key fallbackPK Nested _ ucan -> do UCAN {claims = Claims {sender}} <- ensureM $ getRoot ucan @@ -135,14 +135,8 @@ mkUCAN :: mkUCAN receiver senderSK nbf exp facts resource potency proof = UCAN {..} where sig = signEd25519 header claims senderSK - - sender = DID - { publicKey = Key.Ed25519PublicKey $ Ed25519.toPublic senderSK - , method = DID.Key - } - + sender = DID.Key $ Key.Ed25519PublicKey $ Ed25519.toPublic senderSK claims = Claims {..} - header = Header { typ = UCAN.Typ.JWT , alg = Key.Ed25519 diff --git a/hs-ucan/library/Crypto/Key/Asymmetric/Public.hs b/hs-ucan/library/Crypto/Key/Asymmetric/Public.hs index 3eb6f07c2..e27c82a4c 100644 --- a/hs-ucan/library/Crypto/Key/Asymmetric/Public.hs +++ b/hs-ucan/library/Crypto/Key/Asymmetric/Public.hs @@ -1,10 +1,20 @@ -module Crypto.Key.Asymmetric.Public (genRSA2048) where +module Crypto.Key.Asymmetric.Public + ( genRSA2048 + , decodeASN1DERRSAPublicKey + , encodeASN1DERRSAPublicKey + ) where import qualified Crypto.PubKey.RSA as RSA + +import qualified Data.ASN1.BitArray as ASN1 +import qualified Data.ASN1.Types as ASN1 +import qualified Data.ByteString as BS +import qualified Data.X509 as X509 import qualified OpenSSL.RSA as OpenSSL import RIO import Web.UCAN.Internal.Orphanage.RSA2048.Private () + genRSA2048 :: MonadIO m => m RSA.PrivateKey genRSA2048 = do pair <- liftIO $ OpenSSL.generateRSAKey' 2048 65537 @@ -36,3 +46,43 @@ genRSA2048 = do Just private_qinv -> return RSA.PrivateKey {..} + + +decodeASN1DERRSAPublicKey :: ByteString -> Either String RSA.PublicKey +decodeASN1DERRSAPublicKey bs = + let + spki = + [ ASN1.Start ASN1.Sequence + , ASN1.Start ASN1.Sequence + , ASN1.OID [1,2,840,113549,1,1,1] + , ASN1.Null + , ASN1.End ASN1.Sequence + , ASN1.BitString (ASN1.toBitArray bs (BS.length bs * 8)) + , ASN1.End ASN1.Sequence + ] + in case ASN1.fromASN1 spki of + Right (X509.PubKeyRSA pk, _) -> + Right pk + + Right (pk, _) -> + Left $ "Couldn't parse RSAPublicKey (ASN1 DER encoded). Different format provided: " <> show pk + + Left err -> + Left $ show err + + +encodeASN1DERRSAPublicKey :: RSA.PublicKey -> ByteString +encodeASN1DERRSAPublicKey pk = + case ASN1.toASN1 (X509.PubKeyRSA pk) [] of + [ ASN1.Start ASN1.Sequence + , ASN1.Start ASN1.Sequence + , ASN1.OID [1,2,840,113549,1,1,1] + , ASN1.Null + , ASN1.End ASN1.Sequence + , ASN1.BitString bitArray + , ASN1.End ASN1.Sequence + ] -> + ASN1.bitArrayGetData bitArray + + _ -> + error "Unexpected ASN1 SubjectPublicKeyInfo encoding of RSA public keys" diff --git a/hs-ucan/library/Web/DID/Types.hs b/hs-ucan/library/Web/DID/Types.hs index 73ffe81f4..e11ac4316 100644 --- a/hs-ucan/library/Web/DID/Types.hs +++ b/hs-ucan/library/Web/DID/Types.hs @@ -2,33 +2,32 @@ module Web.DID.Types ( DID (..) ) where -import Data.Aeson as JSON -import qualified Data.Aeson.Types as JSON +import Data.Aeson as JSON +import qualified Data.Aeson.Types as JSON import Data.Swagger -import Control.Lens ((?~)) +import Control.Lens ((?~)) import Test.QuickCheck -import Data.Base58String.Bitcoin as BS58.BTC -import Data.Binary hiding (encode) -import qualified Data.ByteArray as BA -import qualified Data.ByteString.Base64 as BS64 -import qualified Data.ByteString.Builder as Builder -import Data.Hashable (Hashable (..)) +import Data.Base58String.Bitcoin as BS58.BTC +import Data.Binary hiding (encode) +import qualified Data.ByteArray as BA +import qualified Data.ByteString.Base64 as BS64 +import Data.Hashable (Hashable (..)) import Crypto.Error -import qualified Crypto.PubKey.Ed25519 as Ed25519 +import qualified Crypto.PubKey.Ed25519 as Ed25519 import RIO -import qualified RIO.ByteString as BS -import qualified RIO.ByteString.Lazy as Lazy -import qualified RIO.Text as Text +import qualified RIO.ByteString as BS +import qualified RIO.Text as Text -import qualified Web.UCAN.Internal.UTF8 as UTF8 +import qualified Web.UCAN.Internal.UTF8 as UTF8 import Servant.API -import Crypto.Key.Asymmetric as Key (Public (..)) +import Crypto.Key.Asymmetric as Key (Public (..)) +import qualified Crypto.Key.Asymmetric.Public as Public {- | A DID key, broken into its constituant parts @@ -111,7 +110,7 @@ instance Display DID where -- NOTE `pk` here is base2, not base58 0xed : 0x01 : BS.unpack (BA.convert ed) RSAPublicKey rsa -> - 0x12 : 0x05 : BS.unpack (Lazy.toStrict . Builder.toLazyByteString . getUtf8Builder $ display rsa) + 0x85 : 0x24 : BS.unpack (Public.encodeASN1DERRSAPublicKey rsa) instance ToJSON DID where toJSON = String . textDisplay @@ -147,6 +146,12 @@ parseText txt = CryptoFailed cryptoError -> fail $ "Unable to parse Ed25519 key: " <> show cryptoError CryptoPassed edPK -> return $ Ed25519PublicKey edPK + (0x85 : 0x24 : rsaASNPublicKeyW8s) -> + case Public.decodeASN1DERRSAPublicKey $ BS.pack rsaASNPublicKeyW8s of + Right pk -> pure $ RSAPublicKey pk + Left err -> fail err + + -- Backwards compatibility (0x00 : 0xF5 : 0x02 : rsaKeyW8s) -> RSAPublicKey <$> parseKeyW8s (BS64.encode $ BS.pack rsaKeyW8s) diff --git a/hs-ucan/test/Test/Web/DID.hs b/hs-ucan/test/Test/Web/DID.hs index 051a0bc7f..310ca0b1d 100644 --- a/hs-ucan/test/Test/Web/DID.hs +++ b/hs-ucan/test/Test/Web/DID.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -module Test.Web.DID (spec) where +module Test.Web.DID (spec, rsaKey) where import Data.Aeson as JSON import qualified Data.Aeson.Types as JSON From 9263ab4e262c8254895434d05b068e2fb3c39538 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Tue, 25 Jan 2022 11:49:04 +0100 Subject: [PATCH 08/19] Adjust test fixture to use new format --- hs-ucan/test/Test/Web/DID.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/hs-ucan/test/Test/Web/DID.hs b/hs-ucan/test/Test/Web/DID.hs index 310ca0b1d..42d587ac7 100644 --- a/hs-ucan/test/Test/Web/DID.hs +++ b/hs-ucan/test/Test/Web/DID.hs @@ -29,7 +29,8 @@ spec = it "serializes to a well-known value" let expected :: Lazy.ByteString - expected = "did:key:z13V3Sog2YaUKhdGCmgx9UZuW1o1ShFJYc6DvGYe7NTt689NoL2RtpVs65Zw899YrTN9WuxdEEDm54YxWuQHQvcKfkZwa8HTgokHxGDPEmNLhvh69zUMEP4zjuARQ3T8bMUumkSLGpxNe1bfQX624ef45GhWb3S9HM3gvAJ7Qftm8iqnDQVcxwKHjmkV4hveKMTix4bTRhieVHi1oqU4QCVy4QPWpAAympuCP9dAoJFxSP6TNBLY9vPKLazsg7XcFov6UuLWsEaxJ5SomCpDx181mEgW2qTug5oQbrJwExbD9CMgXHLVDE2QgLoQMmgsrPevX57dH715NXC2uY6vo2mYCzRY4KuDRUsrkuYCkewL8q2oK1BEDVvi3Sg8pbC9QYQ5mMiHf8uxiHxTAmPedv8" + -- old format: expected = "did:key:z13V3Sog2YaUKhdGCmgx9UZuW1o1ShFJYc6DvGYe7NTt689NoL2RtpVs65Zw899YrTN9WuxdEEDm54YxWuQHQvcKfkZwa8HTgokHxGDPEmNLhvh69zUMEP4zjuARQ3T8bMUumkSLGpxNe1bfQX624ef45GhWb3S9HM3gvAJ7Qftm8iqnDQVcxwKHjmkV4hveKMTix4bTRhieVHi1oqU4QCVy4QPWpAAympuCP9dAoJFxSP6TNBLY9vPKLazsg7XcFov6UuLWsEaxJ5SomCpDx181mEgW2qTug5oQbrJwExbD9CMgXHLVDE2QgLoQMmgsrPevX57dH715NXC2uY6vo2mYCzRY4KuDRUsrkuYCkewL8q2oK1BEDVvi3Sg8pbC9QYQ5mMiHf8uxiHxTAmPedv8" + expected = "did:key:z4MXj1wBzi9jUstyNvmiK5WLRRL4rr9UvzPxhry1CudCLKWLyMbP1WoTwDfttBTpxDKf5hAJEjqNbeYx2EEvrJmSWHAu7TJRPTrE3QodbMfRvRNRDyYvaN1FSQus2ziS1rWXwAi5Gpc16bY3JwjyLCPJLfdRWHZhRXiay5FWEkfoSKy6aftnzAvqNkKBg2AxgzGMinR6d1WiH4w5mEXFtUeZkeo4uwtRTd8rD9BoVaHVkGwJkksDybE23CsBNXiNfbweFVRcwfTMhcQsTsYhUWDcSC6QE3zt9h4Rsrj7XRYdwYSK5bc1qFRsg5HULKBp2uZ1gcayiW2FqHFcMRjBieC4LnSMSD1AZB1WUncVRbPpVkn1UGhCU" in encode (DID.Key rsaKey) `shouldBe` "\"" <> expected <> "\"" From 42c7b60f44df6433537c78aa05896492a491d42c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Tue, 25 Jan 2022 12:18:30 +0100 Subject: [PATCH 09/19] Fix fission-cli type errors --- fission-cli/library/Fission/CLI/Connected.hs | 7 ++----- fission-cli/library/Fission/CLI/Handler/Setup.hs | 4 ++-- fission-cli/library/Fission/CLI/Handler/User/Login.hs | 8 ++++---- fission-cli/library/Fission/CLI/Handler/User/Register.hs | 4 ++-- fission-web-server/library/Fission/Web/Server/Types.hs | 6 +++--- fission-web-server/test/Fission/Test/Web/Server/Auth.hs | 4 ++-- 6 files changed, 15 insertions(+), 18 deletions(-) diff --git a/fission-cli/library/Fission/CLI/Connected.hs b/fission-cli/library/Fission/CLI/Connected.hs index d413a643e..7dd397736 100644 --- a/fission-cli/library/Fission/CLI/Connected.hs +++ b/fission-cli/library/Fission/CLI/Connected.hs @@ -16,7 +16,7 @@ import qualified Network.IPFS.Process.Error as IPFS.Process import qualified Network.IPFS.Timeout.Types as IPFS import qualified Network.IPFS.Types as IPFS -import Web.DID.Types +import Web.DID.Types as DID import qualified Web.UCAN.Resolver.Error as UCAN.Resolver @@ -155,10 +155,7 @@ mkConnected inCfg ipfsTimeout = do let ignoredFiles = Environment.ignored config - cliDID = DID - { publicKey = Key.Ed25519PublicKey $ Ed25519.toPublic secretKey - , method = Key - } + cliDID = DID.Key $ Key.Ed25519PublicKey $ Ed25519.toPublic secretKey cfg = Config { httpManager = getField @"httpManager" inCfg, ..} diff --git a/fission-cli/library/Fission/CLI/Handler/Setup.hs b/fission-cli/library/Fission/CLI/Handler/Setup.hs index 76df7b174..3c0bc4dde 100644 --- a/fission-cli/library/Fission/CLI/Handler/Setup.hs +++ b/fission-cli/library/Fission/CLI/Handler/Setup.hs @@ -7,7 +7,7 @@ import RIO.FilePath import Network.DNS as DNS import Servant.Client -import Web.DID.Types +import Web.DID.Types as DID import qualified Web.UCAN.Types as UCAN @@ -96,7 +96,7 @@ setup maybeOS maybeUsername maybeEmail maybeKeyFile = do Right username -> do baseURL <- getRemoteBaseUrl signingPK <- Key.Store.fetchPublic (Proxy @SigningKey) - _ <- WNFS.create (DID Key $ Key.Ed25519PublicKey signingPK) "/" + _ <- WNFS.create (DID.Key $ Key.Ed25519PublicKey signingPK) "/" Env.init username baseURL Nothing Display.putOk $ "Done! Welcome to Fission, " <> textDisplay username <> " ✨" diff --git a/fission-cli/library/Fission/CLI/Handler/User/Login.hs b/fission-cli/library/Fission/CLI/Handler/User/Login.hs index 8dcec9b80..082a67a52 100644 --- a/fission-cli/library/Fission/CLI/Handler/User/Login.hs +++ b/fission-cli/library/Fission/CLI/Handler/User/Login.hs @@ -48,7 +48,7 @@ import qualified Fission.Web.Serialization as Web.Serializatio -- 🛂 JWT/UCAN -import Web.DID.Types +import Web.DID.Types as DID import qualified Web.UCAN.Claims.Error as UCAN.Claims import qualified Web.UCAN.Proof as UCAN.Proof import qualified Web.UCAN.Resolver.Class as UCAN @@ -159,7 +159,7 @@ consume signingSK baseURL optUsername = do signingPK <- Key.Store.toPublic (Proxy @SigningKey) signingSK let - myDID = DID Key (Ed25519PublicKey signingPK) + myDID = DID.Key (Ed25519PublicKey signingPK) topic = PubSub.Topic $ textDisplay targetDID PubSub.connect baseURL topic \conn -> reattempt 10 do @@ -167,7 +167,7 @@ consume signingSK baseURL optUsername = do aesConn <- secure conn () \(rsaConn :: Secure.Connection m (RSA.PublicKey, RSA.PrivateKey)) -> reattempt 10 do let Secure.Connection {key = (pk, _sk)} = rsaConn - sessionDID = DID Key (RSAPublicKey pk) + sessionDID = DID.Key (RSAPublicKey pk) logDebug @Text "🤝 Device linking handshake: Step 2" broadcastApiData conn sessionDID @@ -274,7 +274,7 @@ produce signingSK baseURL = do secure conn () \(rsaConn@Secure.Connection {key = (_, sk)} :: Secure.Connection m (RSA.PublicKey, RSA.PrivateKey)) -> reattempt 10 do logDebug @Text "🤝 Device linking handshake: Step 2" - requestorTempDID@(DID _ tmpPK) <- listenRaw conn + requestorTempDID@(DID.Key tmpPK) <- listenRaw conn case tmpPK of Ed25519PublicKey _ -> diff --git a/fission-cli/library/Fission/CLI/Handler/User/Register.hs b/fission-cli/library/Fission/CLI/Handler/User/Register.hs index 5a6f84a41..d3ec0f9ef 100644 --- a/fission-cli/library/Fission/CLI/Handler/User/Register.hs +++ b/fission-cli/library/Fission/CLI/Handler/User/Register.hs @@ -20,7 +20,7 @@ import Fission.User.Username.Types import Fission.Web.Auth.Token.Types import Fission.Web.Client as Client -import Web.DID.Types +import Web.DID.Types as DID import qualified Web.UCAN.Types as UCAN import Fission.User.Email.Types @@ -124,7 +124,7 @@ createAccount maybeUsername maybeEmail = do exchangePK <- KeyStore.fetchPublic (Proxy @ExchangeKey) signingPK <- KeyStore.fetchPublic (Proxy @SigningKey) - _ <- WNFS.create (DID Key $ Key.Ed25519PublicKey signingPK) "/" + _ <- WNFS.create (DID.Key $ Key.Ed25519PublicKey signingPK) "/" let form = Registration diff --git a/fission-web-server/library/Fission/Web/Server/Types.hs b/fission-web-server/library/Fission/Web/Server/Types.hs index 6db288347..c1f9e329d 100644 --- a/fission-web-server/library/Fission/Web/Server/Types.hs +++ b/fission-web-server/library/Fission/Web/Server/Types.hs @@ -559,19 +559,19 @@ instance User.Modifier Server where runUserUpdate updatePK pkToText uID "_did" where updatePK = User.updatePublicKeyDB uID pk now - pkToText pk' = textDisplay (DID Key pk') + pkToText pk' = textDisplay (DID.Key pk') addExchangeKey uID key now = runUserUpdate addKey keysToText uID "_exchange" where addKey = User.addExchangeKeyDB uID key now - keysToText keys = Text.intercalate "," (textDisplay . DID Key . Key.RSAPublicKey <$> keys) + keysToText keys = Text.intercalate "," (textDisplay . DID.Key . Key.RSAPublicKey <$> keys) removeExchangeKey uID key now = runUserUpdate removeKey keysToText uID "_exchange" where removeKey = User.removeExchangeKeyDB uID key now - keysToText keys = Text.intercalate "," (textDisplay . DID Key . Key.RSAPublicKey <$> keys) + keysToText keys = Text.intercalate "," (textDisplay . DID.Key . Key.RSAPublicKey <$> keys) setData userId newCID now = do runDB (User.getById userId) >>= \case diff --git a/fission-web-server/test/Fission/Test/Web/Server/Auth.hs b/fission-web-server/test/Fission/Test/Web/Server/Auth.hs index bef1b043e..7330e8c67 100644 --- a/fission-web-server/test/Fission/Test/Web/Server/Auth.hs +++ b/fission-web-server/test/Fission/Test/Web/Server/Auth.hs @@ -20,7 +20,7 @@ import qualified Fission.Web.API.Heroku.Auth.Types as Heroku import Fission.Web.Server.Auth import Fission.Web.Server.Auth.Token.Basic.Class import Fission.Web.Server.Authorization.Types -import Web.DID.Types +import Web.DID.Types as DID import qualified Fission.Test.Web.Server.Auth.Token as Token @@ -41,7 +41,7 @@ spec = context "DID auth" do it "uses the encapsulated function" do - didResult `shouldBe` Right (DID Key Ed25519.pk) + didResult `shouldBe` Right (DID.Key Ed25519.pk) context "heroku auth" do it "uses the encapsulated function" do From 9bcd52a8127f0b2ed0f3c6d1a630879788520edf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Tue, 25 Jan 2022 14:15:11 +0100 Subject: [PATCH 10/19] Get everything compiling --- .../library/Fission/Web/Server/Auth/Token/UCAN.hs | 6 +++--- .../Fission/Web/Server/Handler/User/Create.hs | 4 ++-- .../Fission/Web/Server/Handler/User/Verify.hs | 1 + .../Fission/Web/Server/Internal/Development.hs | 12 +++--------- .../Fission/Web/Server/Internal/Production.hs | 4 ++-- .../library/Fission/Web/Server/Mock/Config.hs | 15 +++------------ 6 files changed, 14 insertions(+), 28 deletions(-) diff --git a/fission-web-server/library/Fission/Web/Server/Auth/Token/UCAN.hs b/fission-web-server/library/Fission/Web/Server/Auth/Token/UCAN.hs index 3ef862000..8966e8fb4 100644 --- a/fission-web-server/library/Fission/Web/Server/Auth/Token/UCAN.hs +++ b/fission-web-server/library/Fission/Web/Server/Auth/Token/UCAN.hs @@ -1,6 +1,6 @@ module Fission.Web.Server.Auth.Token.UCAN (handler) where -import Web.DID.Types +import Web.DID.Types as DID import Web.UCAN.Resolver as UCAN import qualified Web.UCAN.Types as UCAN import qualified Web.UCAN.Validation as UCAN @@ -42,7 +42,7 @@ handler (Bearer.Token jwt rawContent) = do toAuthorization jwt toAuthorization :: - ( UCAN.Resolver m + ( UCAN.Resolver m , MonadThrow m , MonadLogger m , MonadDB t m @@ -56,7 +56,7 @@ toAuthorization jwt@UCAN.UCAN {claims = UCAN.Claims {..}} = do Left err -> throwM err - Right UCAN.UCAN {claims = UCAN.Claims {sender = DID {publicKey = pk}}} -> + Right UCAN.UCAN {claims = UCAN.Claims {sender = DID.Key pk}} -> runDB (User.getByPublicKey pk) >>= \case Nothing -> Web.Error.throw $ NotFound @User diff --git a/fission-web-server/library/Fission/Web/Server/Handler/User/Create.hs b/fission-web-server/library/Fission/Web/Server/Handler/User/Create.hs index ef972ac8c..465b45f8d 100644 --- a/fission-web-server/library/Fission/Web/Server/Handler/User/Create.hs +++ b/fission-web-server/library/Fission/Web/Server/Handler/User/Create.hs @@ -9,7 +9,7 @@ import Servant.Server.Generic import Fission.Prelude -import Web.DID.Types +import Web.DID.Types as DID import qualified Fission.Web.API.User.Create.Types as User.Create @@ -45,7 +45,7 @@ withDID :: , Challenge.Creator m ) => ServerT User.Create.WithDID m -withDID User.Registration {username, email} DID {..} = do +withDID User.Registration {username, email} (DID.Key publicKey) = do now <- currentTime userId <- Web.Err.ensureM $ User.create username publicKey email now challenge <- Web.Err.ensureM $ Challenge.create userId diff --git a/fission-web-server/library/Fission/Web/Server/Handler/User/Verify.hs b/fission-web-server/library/Fission/Web/Server/Handler/User/Verify.hs index ab1dbf72c..3786d067c 100644 --- a/fission-web-server/library/Fission/Web/Server/Handler/User/Verify.hs +++ b/fission-web-server/library/Fission/Web/Server/Handler/User/Verify.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} module Fission.Web.Server.Handler.User.Verify (handler) where import Servant diff --git a/fission-web-server/library/Fission/Web/Server/Internal/Development.hs b/fission-web-server/library/Fission/Web/Server/Internal/Development.hs index 6d761470d..deddeabc6 100644 --- a/fission-web-server/library/Fission/Web/Server/Internal/Development.hs +++ b/fission-web-server/library/Fission/Web/Server/Internal/Development.hs @@ -27,7 +27,7 @@ import Fission.Prelude import Fission.Internal.Fixture.Key.Ed25519 as Fixture.Ed25519 import Fission.URL.Types -import Web.DID.Types +import Web.DID.Types as DID import Fission.Web.API.Host.Types import Fission.Web.API.Remote @@ -108,10 +108,7 @@ run logFunc dbPool processCtx httpManager tlsManager action = do herokuID = Hku.ID "HEROKU_ID" herokuPassword = Hku.Password "HEROKU_PASSWORD" - fissionDID = DID - { publicKey = Fixture.Ed25519.pk - , method = Key - } + fissionDID = DID.Key $ Fixture.Ed25519.pk environment = LocalDev @@ -185,10 +182,7 @@ mkConfig dbPool processCtx httpManager tlsManager logFunc linkRelayStoreVar mach herokuID = Hku.ID "HEROKU_ID" herokuPassword = Hku.Password "HEROKU_PASSWORD" - fissionDID = DID - { publicKey = Fixture.Ed25519.pk - , method = Key - } + fissionDID = DID.Key $ Fixture.Ed25519.pk ipfsPath = "/usr/local/bin/ipfs" ipfsURLs = Partial.fromJust $ nonEmpty [IPFS.URL $ BaseUrl Http "localhost" 5001 ""] diff --git a/fission-web-server/library/Fission/Web/Server/Internal/Production.hs b/fission-web-server/library/Fission/Web/Server/Internal/Production.hs index d97dbd7cc..99a927999 100644 --- a/fission-web-server/library/Fission/Web/Server/Internal/Production.hs +++ b/fission-web-server/library/Fission/Web/Server/Internal/Production.hs @@ -39,7 +39,7 @@ import Fission.Prelude import Fission.Internal.App import Fission.Time -import Web.DID.Types +import Web.DID.Types as DID import Fission.Web.API.Host.Types as Server import qualified Fission.Web.API.Types as Fission @@ -195,7 +195,7 @@ start middleware runner = do now <- currentTime cfg@Fission.Server.Config {..} <- ask - let DID _ serverPK = fissionDID + let DID.Key serverPK = fissionDID logDebug $ displayShow cfg diff --git a/fission-web-server/library/Fission/Web/Server/Mock/Config.hs b/fission-web-server/library/Fission/Web/Server/Mock/Config.hs index 827438dfc..e7c4889cb 100644 --- a/fission-web-server/library/Fission/Web/Server/Mock/Config.hs +++ b/fission-web-server/library/Fission/Web/Server/Mock/Config.hs @@ -11,7 +11,7 @@ import qualified Network.IPFS.Types as IPFS import Servant import Servant.Server.Experimental.Auth -import Web.DID.Types +import Web.DID.Types as DID import Fission.Prelude @@ -39,11 +39,7 @@ defaultConfig :: Config defaultConfig = Config { now = agesAgo , linkedPeers = pure $ IPFS.Peer "ipv4/fakepeeraddress" - , didVerifier = mkAuthHandler \_ -> - return $ DID - { publicKey = pk - , method = Key - } + , didVerifier = mkAuthHandler \_ -> pure $ DID.Key pk , userVerifier = mkAuthHandler \_ -> pure $ Fixture.entity Fixture.user , authVerifier = mkAuthHandler \_ -> authZ , herokuVerifier = BasicAuthCheck \_ -> pure . Authorized $ Heroku.Auth "FAKE HEROKU" @@ -68,13 +64,8 @@ defaultConfig = Config authZ :: Monad m => m Authorization authZ = return Authorization - { sender = Right did + { sender = Right $ DID.Key $ Fixture.Ed25519.pk , about = Fixture.entity Fixture.user , potency = Just AppendOnly , resource = Subset $ FissionFileSystem "/test/" } - where - did = DID - { publicKey = Fixture.Ed25519.pk - , method = Key - } From 263269ade360d3d73af186da669e44bf3e261119 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Thu, 27 Jan 2022 10:48:34 +0100 Subject: [PATCH 11/19] Fix one remaining type error --- .../test/Fission/Test/Web/Auth/Signature/Ed25519.hs | 7 ++----- hs-ucan/library/Web/DID/Types.hs | 4 ++-- 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/fission-core/test/Fission/Test/Web/Auth/Signature/Ed25519.hs b/fission-core/test/Fission/Test/Web/Auth/Signature/Ed25519.hs index 2391a0809..d2a6a35a0 100644 --- a/fission-core/test/Fission/Test/Web/Auth/Signature/Ed25519.hs +++ b/fission-core/test/Fission/Test/Web/Auth/Signature/Ed25519.hs @@ -6,7 +6,7 @@ import qualified Crypto.Key.Asymmetric as Key import Crypto.Key.Asymmetric.Algorithm.Types import qualified Crypto.PubKey.Ed25519 as Ed25519 -import Web.DID.Types +import Web.DID.Types as DID import qualified Web.UCAN.Internal.Base64.URL as B64.URL import qualified Web.UCAN.RawContent as UCAN import Web.UCAN.Types @@ -26,10 +26,7 @@ spec = sig' = signEd25519 header' claims' sk rawContent = UCAN.RawContent $ B64.URL.encodeJWT header' claims' - did = DID - { publicKey = Key.Ed25519PublicKey pk - , method = Key - } + did = DID.Key $ Key.Ed25519PublicKey pk ucan' = ucan { header = header' diff --git a/hs-ucan/library/Web/DID/Types.hs b/hs-ucan/library/Web/DID/Types.hs index e11ac4316..20c901e9e 100644 --- a/hs-ucan/library/Web/DID/Types.hs +++ b/hs-ucan/library/Web/DID/Types.hs @@ -65,12 +65,12 @@ More here: https://github.com/multiformats/unsigned-varint Ed25519 > eitherDecode (encode "did:key:z6MkgYGF3thn8k1Fv4p4dWXKtsXCnLH7q9yw4QgNPULDmDKB") :: Either String DID -Right (DID {method = Key, publicKey = Hv+AVRD2WUjUFOsSNbsmrp9fokuwrUnjBcr92f0kxw4=}) +Right (DID.Key Hv+AVRD2WUjUFOsSNbsmrp9fokuwrUnjBcr92f0kxw4=) RSA > eitherDecode "\"did:key:z1LBnwEktwYLrpPhuwFowdVwAFX5zpRo9rrVzwiRRBBiaBoCR7hNqgstW7VM3T9auNbqTmQW4vdHb61RhTMVgCp1BTxuaKU3anWoERFXpuZvfE39g8u7HS9BeD1QJN1fX6S8vvskaPhxFkwLtGr4ZffkUE57WZpNWM6U6BqdktZxmKzxC85zN4FC9Ws5LHuGfxaCuBLiUfA7qEYVSz1Qu1rZDpD6NyfUNrHJ1ErZduJun976nbFHrmDnU47RcSMFESbNKDi1467tRfubsMrDzebdCFKQ2m1AYysto2i6Wmcnucjt3tnwTqe7Bo8L1g8h8UGA946DF3WeGbPUGqznsUdLq6XLCmJzJkJmrNyeZkswdyPX2Vu6J9E4J12Sb3h9ds7atByamftitEZsf6hPJkLUXGThYpCnmRAArRRfPY2H6cKDc7AcnFPyNHGkab5ZFo4qvgBZytbK1K5oD3HfQ6E2ybLhyC2b8i5wo6DLtm9ufixSJNNTH7Uikk88CmertKR7s12CK1WLEM3Zu5YBZNphnjj7cp8QTodAehRPV9NG1CLEAMJVN79DvYe6SfiafJobcvfD8npfS6jcejcyouQbEpKDG7QAnKS48P4AvgBqDvfNUe54jMkk6r6CoX4LcYGHukZDEnea9kwkEoXkUYS4j1AfbKh44FzSuXbQqZnjjVpThxCNmmNn1E4qHmsFkvGoF3FN55CPkoGfDCvyQJgqmsFmpeTJSy9wzv4MvbqpuATxr7eyxsGeCWQkcDwub32inGpR3reTfzRJECCFZarnXdcC5Pidakb1Wu8L\"" -Right (DID {method = Key, publicKey = MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAnzyis1ZjfNB0bBgKFMSvvkTtwlvBsaJq7S5wA+kzeVOVpVWwkWdVha4s38XM/pa/yr47av7+z3VTmvDRyAHcaT92whREFpLv9cj5lTeJSibyr/Mrm/YtjCZVWgaOYIhwrXwKLqPr/11inWsAkfIytvHWTxZYEcXLgAXFuUuaS3uF9gEiNQwzGTU1v0FqkqTBr4B8nW3HCN47XUu0t8Y0e+lf4s4OxQawWD79J9/5d3Ry0vbV3Am1FtGJiJvOwRsIfVChDpYStTcHTCMqtvWbV6L11BWkpzGXSW4Hv43qa+GSYOD2QU68Mb59oSk2OB+BtOLpJofmbGEGgvmwyCI9MwIDAQAB}) +Right (DID.Key MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAnzyis1ZjfNB0bBgKFMSvvkTtwlvBsaJq7S5wA+kzeVOVpVWwkWdVha4s38XM/pa/yr47av7+z3VTmvDRyAHcaT92whREFpLv9cj5lTeJSibyr/Mrm/YtjCZVWgaOYIhwrXwKLqPr/11inWsAkfIytvHWTxZYEcXLgAXFuUuaS3uF9gEiNQwzGTU1v0FqkqTBr4B8nW3HCN47XUu0t8Y0e+lf4s4OxQawWD79J9/5d3Ry0vbV3Am1FtGJiJvOwRsIfVChDpYStTcHTCMqtvWbV6L11BWkpzGXSW4Hv43qa+GSYOD2QU68Mb59oSk2OB+BtOLpJofmbGEGgvmwyCI9MwIDAQAB) -} data DID From 2edd6abb8f006860eb79e389828058fcf3366cb1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Fri, 28 Jan 2022 16:59:52 +0100 Subject: [PATCH 12/19] Fix type error --- fission-core/test/Fission/Test.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/fission-core/test/Fission/Test.hs b/fission-core/test/Fission/Test.hs index 04529f336..04312e22c 100644 --- a/fission-core/test/Fission/Test.hs +++ b/fission-core/test/Fission/Test.hs @@ -8,7 +8,6 @@ import qualified Fission.Test.Internal.Bool as Bool import qualified Fission.Test.Internal.UTF8 as UTF8 import qualified Fission.Test.Random as Random import qualified Fission.Test.URL as URL -import qualified Fission.Test.User.DID as DID import qualified Fission.Test.Web.Auth.Signature.Ed25519 as Ed import qualified Fission.Test.Web.Auth.Token.Bearer as Bearer import qualified Fission.Test.Web.Auth.Token.UCAN as UCAN @@ -20,7 +19,6 @@ spec :: Spec spec = describe "Fission" do Bool.spec - DID.spec DNS.spec Environment.spec Random.spec From 8f4c1ea05799c2eb6d67e38b4fc61c73597887ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Mon, 31 Jan 2022 12:46:52 +0100 Subject: [PATCH 13/19] Revert "Niv update" This reverts commit 3a11d683d2825fa1e5d643a61f8abb912ea6b0d4. --- nix/sources.json | 24 ++++++++++++------------ shell.nix | 3 +++ 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/nix/sources.json b/nix/sources.json index 90d507c81..7c2f57068 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -5,10 +5,10 @@ "homepage": "", "owner": "NixOS", "repo": "nixpkgs", - "rev": "1c1f5649bb9c1b0d98637c8c365228f57126f361", - "sha256": "0f2nvdijyxfgl5kwyb4465pppd5vkhqxddx6v40k2s0z9jfhj0xl", + "rev": "068984c00e0d4e54b6684d98f6ac47c92dcb642e", + "sha256": "00j4xv4lhhqwry7jd67brnws4pwb8vn660n43pvxpkalbpxszwfg", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs/archive/1c1f5649bb9c1b0d98637c8c365228f57126f361.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/068984c00e0d4e54b6684d98f6ac47c92dcb642e.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "niv": { @@ -17,10 +17,10 @@ "homepage": "https://github.com/nmattia/niv", "owner": "nmattia", "repo": "niv", - "rev": "5830a4dd348d77e39a0f3c4c762ff2663b602d4c", - "sha256": "1d3lsrqvci4qz2hwjrcnd8h5vfkg8aypq3sjd4g3izbc8frwz5sm", + "rev": "e0ca65c81a2d7a4d82a189f1e23a48d59ad42070", + "sha256": "1pq9nh1d8nn3xvbdny8fafzw87mj7gsmp6pxkdl65w2g18rmcmzx", "type": "tarball", - "url": "https://github.com/nmattia/niv/archive/5830a4dd348d77e39a0f3c4c762ff2663b602d4c.tar.gz", + "url": "https://github.com/nmattia/niv/archive/e0ca65c81a2d7a4d82a189f1e23a48d59ad42070.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "nixos": { @@ -29,10 +29,10 @@ "homepage": "", "owner": "NixOS", "repo": "nixpkgs", - "rev": "0fd9ee1aa36ce865ad273f4f07fdc093adeb5c00", - "sha256": "1mr2qgv5r2nmf6s3gqpcjj76zpsca6r61grzmqngwm0xlh958smx", + "rev": "8b0b81dab17753ab344a44c04be90a61dc55badf", + "sha256": "0rj17jpjxjcibcd4qygpxbq79m4px6b35nqq9353pns8w7a984xx", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs/archive/0fd9ee1aa36ce865ad273f4f07fdc093adeb5c00.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/8b0b81dab17753ab344a44c04be90a61dc55badf.tar.gz", "url_template": "https://github.com///archive/.tar.gz" }, "unstable": { @@ -41,10 +41,10 @@ "homepage": "", "owner": "NixOS", "repo": "nixpkgs", - "rev": "689b76bcf36055afdeb2e9852f5ecdd2bf483f87", - "sha256": "08d38db4707jdm3gws82y6bynh6k8qal4s1cms9zqd9cdwcmylyj", + "rev": "bbbe2b35f736d039884e082ecc6d6e631e126029", + "sha256": "09356lp9r1wx311ak6d94bx35xnvj8cabvwqirklylql8q7f52lc", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs/archive/689b76bcf36055afdeb2e9852f5ecdd2bf483f87.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/bbbe2b35f736d039884e082ecc6d6e631e126029.tar.gz", "url_template": "https://github.com///archive/.tar.gz" } } diff --git a/shell.nix b/shell.nix index 1c6c8a240..9aa4ac435 100644 --- a/shell.nix +++ b/shell.nix @@ -22,6 +22,7 @@ deps = { common = [ + pkgs.gnumake unstable.niv ]; @@ -42,6 +43,8 @@ ]; haskell = [ + unstable.ghc + unstable.haskellPackages.implicit-hie unstable.haskell-language-server unstable.stack unstable.stylish-haskell From a3c1b703b9cdd1e6d2bb77848bdca831e5a8e82a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Mon, 31 Jan 2022 12:48:02 +0100 Subject: [PATCH 14/19] Cherry-pick some changes from "Niv update" --- shell.nix | 3 --- 1 file changed, 3 deletions(-) diff --git a/shell.nix b/shell.nix index 9aa4ac435..1c6c8a240 100644 --- a/shell.nix +++ b/shell.nix @@ -22,7 +22,6 @@ deps = { common = [ - pkgs.gnumake unstable.niv ]; @@ -43,8 +42,6 @@ ]; haskell = [ - unstable.ghc - unstable.haskellPackages.implicit-hie unstable.haskell-language-server unstable.stack unstable.stylish-haskell From ddac7a54bf0ce9d14439fe4a2c7a29970fd31bba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Mon, 31 Jan 2022 12:49:32 +0100 Subject: [PATCH 15/19] Remove AllowAmbiguousTypes --- fission-web-client/library/Fission/Web/Client.hs | 2 -- .../library/Fission/Web/Server/Handler/User/Verify.hs | 1 - hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs | 1 - 3 files changed, 4 deletions(-) diff --git a/fission-web-client/library/Fission/Web/Client.hs b/fission-web-client/library/Fission/Web/Client.hs index e8d20aa53..44d6e271a 100644 --- a/fission-web-client/library/Fission/Web/Client.hs +++ b/fission-web-client/library/Fission/Web/Client.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} - module Fission.Web.Client ( sendRequestM , sendAuthedRequest diff --git a/fission-web-server/library/Fission/Web/Server/Handler/User/Verify.hs b/fission-web-server/library/Fission/Web/Server/Handler/User/Verify.hs index 3786d067c..ab1dbf72c 100644 --- a/fission-web-server/library/Fission/Web/Server/Handler/User/Verify.hs +++ b/fission-web-server/library/Fission/Web/Server/Handler/User/Verify.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} module Fission.Web.Server.Handler.User.Verify (handler) where import Servant diff --git a/hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs b/hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs index faa9e66cd..e82279119 100644 --- a/hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs +++ b/hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Web.UCAN.DelegationSemantics ( reflexive From 682846649b4b283e632b2c7f3881950b4ecc2955 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Mon, 31 Jan 2022 12:52:00 +0100 Subject: [PATCH 16/19] Move Test.Prelude to Test.Web.UCAN.Prelude --- hs-ucan/test/Main.hs | 2 +- hs-ucan/test/Test/Web/DID.hs | 2 +- hs-ucan/test/Test/Web/UCAN.hs | 2 +- hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs | 2 +- hs-ucan/test/Test/Web/UCAN/Example.hs | 2 +- hs-ucan/test/Test/{ => Web/UCAN}/Prelude.hs | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) rename hs-ucan/test/Test/{ => Web/UCAN}/Prelude.hs (96%) diff --git a/hs-ucan/test/Main.hs b/hs-ucan/test/Main.hs index 570b3fd97..17d453a2f 100644 --- a/hs-ucan/test/Main.hs +++ b/hs-ucan/test/Main.hs @@ -1,6 +1,6 @@ module Main (main) where -import Test.Prelude +import Test.Web.UCAN.Prelude import qualified Test.Web.DID as DID import qualified Test.Web.UCAN as UCAN diff --git a/hs-ucan/test/Test/Web/DID.hs b/hs-ucan/test/Test/Web/DID.hs index 42d587ac7..1da69eb62 100644 --- a/hs-ucan/test/Test/Web/DID.hs +++ b/hs-ucan/test/Test/Web/DID.hs @@ -12,7 +12,7 @@ import Crypto.Key.Asymmetric as Key import qualified Crypto.Key.Asymmetric.Algorithm.Types as Alg import qualified Crypto.PubKey.Ed25519 as Ed25519 -import Test.Prelude +import Test.Web.UCAN.Prelude import Web.DID.Oldstyle.Types import Web.DID.Types as DID diff --git a/hs-ucan/test/Test/Web/UCAN.hs b/hs-ucan/test/Test/Web/UCAN.hs index f0cd9f6b5..fab79ad56 100644 --- a/hs-ucan/test/Test/Web/UCAN.hs +++ b/hs-ucan/test/Test/Web/UCAN.hs @@ -6,7 +6,7 @@ import qualified RIO.ByteString.Lazy as Lazy import qualified RIO.Char as Char import Web.UCAN.Types -import Test.Prelude +import Test.Web.UCAN.Prelude import qualified Test.Web.UCAN.DelegationSemantics as DelegationSemantics import Test.Web.UCAN.Example diff --git a/hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs b/hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs index e82279119..3be8d28bd 100644 --- a/hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs +++ b/hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs @@ -6,7 +6,7 @@ module Test.Web.UCAN.DelegationSemantics , partialOrderProperties ) where -import Test.Prelude +import Test.Web.UCAN.Prelude import Web.UCAN.Proof.Class import Web.UCAN.Proof.Properties diff --git a/hs-ucan/test/Test/Web/UCAN/Example.hs b/hs-ucan/test/Test/Web/UCAN/Example.hs index a403f8e6e..a5127991e 100644 --- a/hs-ucan/test/Test/Web/UCAN/Example.hs +++ b/hs-ucan/test/Test/Web/UCAN/Example.hs @@ -5,7 +5,7 @@ module Test.Web.UCAN.Example ) where import qualified RIO.Text as Text -import Test.Prelude +import Test.Web.UCAN.Prelude import Web.UCAN.Proof.Class diff --git a/hs-ucan/test/Test/Prelude.hs b/hs-ucan/test/Test/Web/UCAN/Prelude.hs similarity index 96% rename from hs-ucan/test/Test/Prelude.hs rename to hs-ucan/test/Test/Web/UCAN/Prelude.hs index 8397a21fd..0723e47f2 100644 --- a/hs-ucan/test/Test/Prelude.hs +++ b/hs-ucan/test/Test/Web/UCAN/Prelude.hs @@ -1,4 +1,4 @@ -module Test.Prelude +module Test.Web.UCAN.Prelude ( module RIO , module Data.Aeson From ba6dee4990315911cd0d35165fa7fb8922bf6573 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Mon, 31 Jan 2022 21:46:38 +0100 Subject: [PATCH 17/19] Re-add AllowAmbigousTypes for DelegationSemantics I'm pretty sure I need this? https://github.com/fission-suite/fission/runs/5005311975 --- hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs b/hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs index 3be8d28bd..4ce976dcb 100644 --- a/hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs +++ b/hs-ucan/test/Test/Web/UCAN/DelegationSemantics.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Web.UCAN.DelegationSemantics ( reflexive From c487afb53d08e41b73090d84c19e5ab0ad6e1aa5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Fri, 4 Feb 2022 17:34:22 +0100 Subject: [PATCH 18/19] Revert encoding DIDs in new format The rest of the system needs to understand the new format first! Still, we can now *consume* the new format in the server/CLI. --- hs-ucan/library/Web/DID/Types.hs | 3 ++- .../UCAN/Internal/Orphanage/RSA2048/Public.hs | 22 ++++++++++++------- hs-ucan/test/Test/Web/DID.hs | 6 ++--- 3 files changed, 19 insertions(+), 12 deletions(-) diff --git a/hs-ucan/library/Web/DID/Types.hs b/hs-ucan/library/Web/DID/Types.hs index 20c901e9e..6455b3625 100644 --- a/hs-ucan/library/Web/DID/Types.hs +++ b/hs-ucan/library/Web/DID/Types.hs @@ -110,7 +110,8 @@ instance Display DID where -- NOTE `pk` here is base2, not base58 0xed : 0x01 : BS.unpack (BA.convert ed) RSAPublicKey rsa -> - 0x85 : 0x24 : BS.unpack (Public.encodeASN1DERRSAPublicKey rsa) + -- breaking change, but spec-adhering format: 0x85 : 0x24 : BS.unpack (Public.encodeASN1DERRSAPublicKey rsa) + 0x00 : 0xF5 : 0x02 : BS.unpack (BS64.decodeLenient . encodeUtf8 $ textDisplay rsa) instance ToJSON DID where toJSON = String . textDisplay diff --git a/hs-ucan/library/Web/UCAN/Internal/Orphanage/RSA2048/Public.hs b/hs-ucan/library/Web/UCAN/Internal/Orphanage/RSA2048/Public.hs index 4f08db004..b7fb2d94f 100644 --- a/hs-ucan/library/Web/UCAN/Internal/Orphanage/RSA2048/Public.hs +++ b/hs-ucan/library/Web/UCAN/Internal/Orphanage/RSA2048/Public.hs @@ -14,7 +14,6 @@ import qualified Data.ASN1.Types as ASN1 import qualified Data.PEM as PEM import qualified Data.ByteString.Base64 as BS64 -import qualified Data.ByteString.Builder as Builder import qualified Data.X509 as X509 import Data.Swagger @@ -36,14 +35,15 @@ instance Arbitrary RSA.PublicKey where return . fst . Unsafe.unsafePerformIO $ RSA.generate 2048 exp instance Display RSA.PublicKey where - display pk = - pk - & X509.PubKeyRSA + textDisplay pk = + X509.PubKeyRSA pk & X509.pubKeyToPEM - & PEM.pemContent - & BS64.decodeLenient - & Builder.byteString - & Utf8Builder + & PEM.pemWriteBS + & decodeUtf8Lenient + & Text.strip + & Text.dropPrefix pemHeader + & Text.dropSuffix pemFooter + & Text.filter (/= '\n') instance ToHttpApiData RSA.PublicKey where toUrlPiece = textDisplay @@ -83,3 +83,9 @@ instance ToSchema RSA.PublicKey where & description ?~ "An RSA public key" & NamedSchema (Just "RSA.PublicKey") & pure + +pemHeader :: Text +pemHeader = "-----BEGIN PUBLIC KEY-----" + +pemFooter :: Text +pemFooter = "-----END PUBLIC KEY-----" diff --git a/hs-ucan/test/Test/Web/DID.hs b/hs-ucan/test/Test/Web/DID.hs index 1da69eb62..d796cd183 100644 --- a/hs-ucan/test/Test/Web/DID.hs +++ b/hs-ucan/test/Test/Web/DID.hs @@ -29,8 +29,8 @@ spec = it "serializes to a well-known value" let expected :: Lazy.ByteString - -- old format: expected = "did:key:z13V3Sog2YaUKhdGCmgx9UZuW1o1ShFJYc6DvGYe7NTt689NoL2RtpVs65Zw899YrTN9WuxdEEDm54YxWuQHQvcKfkZwa8HTgokHxGDPEmNLhvh69zUMEP4zjuARQ3T8bMUumkSLGpxNe1bfQX624ef45GhWb3S9HM3gvAJ7Qftm8iqnDQVcxwKHjmkV4hveKMTix4bTRhieVHi1oqU4QCVy4QPWpAAympuCP9dAoJFxSP6TNBLY9vPKLazsg7XcFov6UuLWsEaxJ5SomCpDx181mEgW2qTug5oQbrJwExbD9CMgXHLVDE2QgLoQMmgsrPevX57dH715NXC2uY6vo2mYCzRY4KuDRUsrkuYCkewL8q2oK1BEDVvi3Sg8pbC9QYQ5mMiHf8uxiHxTAmPedv8" - expected = "did:key:z4MXj1wBzi9jUstyNvmiK5WLRRL4rr9UvzPxhry1CudCLKWLyMbP1WoTwDfttBTpxDKf5hAJEjqNbeYx2EEvrJmSWHAu7TJRPTrE3QodbMfRvRNRDyYvaN1FSQus2ziS1rWXwAi5Gpc16bY3JwjyLCPJLfdRWHZhRXiay5FWEkfoSKy6aftnzAvqNkKBg2AxgzGMinR6d1WiH4w5mEXFtUeZkeo4uwtRTd8rD9BoVaHVkGwJkksDybE23CsBNXiNfbweFVRcwfTMhcQsTsYhUWDcSC6QE3zt9h4Rsrj7XRYdwYSK5bc1qFRsg5HULKBp2uZ1gcayiW2FqHFcMRjBieC4LnSMSD1AZB1WUncVRbPpVkn1UGhCU" + expected = "did:key:z13V3Sog2YaUKhdGCmgx9UZuW1o1ShFJYc6DvGYe7NTt689NoL2RtpVs65Zw899YrTN9WuxdEEDm54YxWuQHQvcKfkZwa8HTgokHxGDPEmNLhvh69zUMEP4zjuARQ3T8bMUumkSLGpxNe1bfQX624ef45GhWb3S9HM3gvAJ7Qftm8iqnDQVcxwKHjmkV4hveKMTix4bTRhieVHi1oqU4QCVy4QPWpAAympuCP9dAoJFxSP6TNBLY9vPKLazsg7XcFov6UuLWsEaxJ5SomCpDx181mEgW2qTug5oQbrJwExbD9CMgXHLVDE2QgLoQMmgsrPevX57dH715NXC2uY6vo2mYCzRY4KuDRUsrkuYCkewL8q2oK1BEDVvi3Sg8pbC9QYQ5mMiHf8uxiHxTAmPedv8" + -- new format: expected = "did:key:z4MXj1wBzi9jUstyNvmiK5WLRRL4rr9UvzPxhry1CudCLKWLyMbP1WoTwDfttBTpxDKf5hAJEjqNbeYx2EEvrJmSWHAu7TJRPTrE3QodbMfRvRNRDyYvaN1FSQus2ziS1rWXwAi5Gpc16bY3JwjyLCPJLfdRWHZhRXiay5FWEkfoSKy6aftnzAvqNkKBg2AxgzGMinR6d1WiH4w5mEXFtUeZkeo4uwtRTd8rD9BoVaHVkGwJkksDybE23CsBNXiNfbweFVRcwfTMhcQsTsYhUWDcSC6QE3zt9h4Rsrj7XRYdwYSK5bc1qFRsg5HULKBp2uZ1gcayiW2FqHFcMRjBieC4LnSMSD1AZB1WUncVRbPpVkn1UGhCU" in encode (DID.Key rsaKey) `shouldBe` "\"" <> expected <> "\"" @@ -63,7 +63,7 @@ spec = itsProp' "is a base58 encoded Key DID" \(did :: DID) -> Lazy.isPrefixOf "\"did:key:z" (JSON.encode did) - itsProp' "seralized is isomorphic to ADT" \(did :: DID) -> + itsProp' "serialized is isomorphic to ADT" \(did :: DID) -> JSON.eitherDecode (JSON.encode did) `shouldBe` Right did describe "fixtures" do From c57e6aeb0d89bc2afb3fb55cc376be318b9fa9de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Philipp=20Kr=C3=BCger?= Date: Fri, 4 Feb 2022 17:36:41 +0100 Subject: [PATCH 19/19] Remove unused orphan --- .../library/Fission/Internal/Orphanage/RSA2048.hs | 13 ------------- 1 file changed, 13 deletions(-) delete mode 100644 fission-core/library/Fission/Internal/Orphanage/RSA2048.hs diff --git a/fission-core/library/Fission/Internal/Orphanage/RSA2048.hs b/fission-core/library/Fission/Internal/Orphanage/RSA2048.hs deleted file mode 100644 index f485e9deb..000000000 --- a/fission-core/library/Fission/Internal/Orphanage/RSA2048.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Fission.Internal.Orphanage.RSA2048 () where - -import qualified Crypto.PubKey.Ed25519 as Ed25519 -import qualified System.IO.Unsafe as Unsafe - -import Fission.Prelude - - --- Wait. This is weird. How did this end up in this module? -instance Arbitrary Ed25519.SecretKey where - arbitrary = return . Unsafe.unsafePerformIO $ Ed25519.generateSecretKey