Manually import core changes from ##550

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

hs-ucan/library/Web/DID/Oldstyle/Types.hs

@@ -7,16 +7,15 @@ 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
 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))

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,21 +13,22 @@ 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
 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
 
 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

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

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-----"

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 {..}
 

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

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 ()

hs-ucan/test/Test/Web/DID.hs

@@ -31,33 +31,33 @@ 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"
           let
             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)]

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