Upgrade DID RSA Key format (#573)

* Write DID signature verification & tests * Write failing rsa DID test * Move over DID tests * Manually import core changes from ##550 * Niv update * Remove redundant test * Parse ASN1 DER RSAPublicKeys * Adjust test fixture to use new format * Fix fission-cli type errors * Get everything compiling * Fix one remaining type error * Fix type error * Revert "Niv update" This reverts commit 3a11d68. * Cherry-pick some changes from "Niv update" * Remove AllowAmbiguousTypes * Move Test.Prelude to Test.Web.UCAN.Prelude * Re-add AllowAmbigousTypes for DelegationSemantics I'm pretty sure I need this? https://github.com/fission-suite/fission/runs/5005311975 * 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. * Remove unused orphan
fission-codes · Feb 4, 2022 · c7f5907 · c7f5907
1 parent ae17740
commit c7f5907
Show file tree

Hide file tree

Showing 30 changed files with 351 additions and 242 deletions.
diff --git 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
@@ -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
@@ -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,15 +159,15 @@ 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
     logDebug @Text "🤝 Device linking handshake: Step 1"
     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
@@ -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-core/library/Fission/Internal/Orphanage/RSA2048.hs b/fission-core/library/Fission/Internal/Orphanage/RSA2048.hs
diff --git 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/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

diff --git a/fission-core/test/Fission/Test/User/DID.hs b/fission-core/test/Fission/Test/User/DID.hs
diff --git 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/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/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
@@ -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/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
@@ -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
@@ -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
-        }