fission-codes · matheus23 · Feb 4, 2022 · Feb 11, 2022 · Feb 15, 2022 · Mar 14, 2022
diff --git a/.gitignore b/.gitignore
@@ -14,6 +14,7 @@ result
 yesod-devel/*
 addon-manifest.json
 env.yaml
+server.yaml
 domain-key.txt
 domain-crt.txt
 
@@ -587,4 +588,5 @@ MigrationBackup/
 
 # End of https://www.gitignore.io/api/vim,emacs,sublimetext,visualstudio
 
-
+fission-web-server/data/
+fission-web-server/.env
diff --git a/fission-cli/library/Fission/CLI.hs b/fission-cli/library/Fission/CLI.hs
@@ -63,6 +63,7 @@ cli = do
         Http  -> defaultManagerSettings
         Https -> tlsManagerSettings
 
+  tlsManager <- liftIO $ HTTP.newManager tlsManagerSettings
   httpManager <- liftIO $ HTTP.newManager rawHTTPSettings
     { managerResponseTimeout = responseTimeoutMicro 1_800_000_000 }
 

diff --git a/fission-cli/library/Fission/CLI/App.hs b/fission-cli/library/Fission/CLI/App.hs
@@ -14,6 +14,8 @@ import           Fission.CLI.Connected                   as Connected
 
 import           Fission.CLI.App.Environment             as App.Env
 import qualified Fission.CLI.Display.Error               as CLI.Error
+import           Fission.CLI.Environment                 as CLI.Env hiding (Env)
+import           Fission.CLI.Error.Types
 import qualified Fission.CLI.Handler                     as Handler
 import           Fission.CLI.Handler.Error.Types         (Errs)
 
@@ -44,22 +46,33 @@ interpret baseCfg cmd = do
         run' :: FissionCLI errs Connected.Config () -> FissionCLI errs Base.Config ()
         run' = ensureM . Connected.run baseCfg timeoutSeconds
 
-      attempt App.Env.read >>= \case
-        Right Env {appURL} -> do
-          UTF8.putTextLn $ "App already set up at " <> textDisplay appURL
-          logDebug . textDisplay $ AlreadyExists @URL
-          raise $ AlreadyExists @URL
-
-        Left errs -> do
-          case openUnionMatch @(NotFound FilePath) errs of
-            Just _ -> do
-              logDebug @Text "Setting up new app"
-              run' $ Handler.appInit appDir buildDir mayAppName
-
-            Nothing -> do
-              logError @Text "Problem setting up new app"
+      attempt CLI.Env.alreadySetup >>= \case
+        Left errs ->
+          case openUnionMatch @NotSetup errs of
+            Just err -> do
+              CLI.Error.put err "Fission is installed, but you are not logged in. Please run `fission login`"
+              raise errs
+
+            Nothing ->
               raise errs
 
+        Right _ ->
+          attempt App.Env.read >>= \case
+            Right Env {appURL} -> do
+              UTF8.putTextLn $ "App already set up at " <> textDisplay appURL
+              logDebug . textDisplay $ AlreadyExists @URL
+              raise $ AlreadyExists @URL
+
+            Left errs -> do
+              case openUnionMatch @(NotFound FilePath) errs of
+                Just _ -> do
+                  logDebug @Text "Setting up new app"
+                  run' $ Handler.appInit appDir buildDir mayAppName
+
+                Nothing -> do
+                  logError @Text "Problem setting up new app"
+                  raise errs
+
     Up App.Up.Options {open, watch, updateDNS, updateData, filePath, ipfsCfg = IPFS.Config {..}} -> do
       let
         run' :: FissionCLI errs Connected.Config () -> FissionCLI errs Base.Config ()

diff --git a/fission-cli/library/Fission/CLI/Base/Types.hs b/fission-cli/library/Fission/CLI/Base/Types.hs
@@ -15,6 +15,7 @@ import           Fission.CLI.Remote
 -- | The configuration used for the CLI application
 data Config = Config
   { httpManager   :: HTTP.Manager
+  , tlsManager    :: HTTP.Manager
   , ipfsTimeout   :: IPFS.Timeout
   , ipfsURL       :: IPFS.URL
   , remote        :: Remote

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
 
@@ -61,6 +61,7 @@ type BaseErrs =
    , SomeException
    , IPFS.UnableToConnect
    , NotRegistered
+   , NotSetup
    , NotFound [IPFS.Peer]
    , NotFound Ed25519.SecretKey
    ]
@@ -155,10 +156,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, ..}
 
@@ -167,7 +165,7 @@ mkConnected inCfg ipfsTimeout = do
             proof <- getRootUserProof
             attempt (sendAuthedRequest proof whoAmI) >>= \case
               Left err -> do
-                CLI.Error.put err "Not registered. Please run: fission user login"
+                CLI.Error.put err "Not registered. Please run `fission user login`"
                 raise NotRegistered
 
               Right username -> do

diff --git a/fission-cli/library/Fission/CLI/Environment.hs b/fission-cli/library/Fission/CLI/Environment.hs
@@ -7,6 +7,7 @@ module Fission.CLI.Environment
   , getOrRetrievePeers
   , absPath
   , fetchServerDID
+  , alreadySetup
 
   -- * Reexport
 
@@ -15,6 +16,7 @@ module Fission.CLI.Environment
   ) where
 
 import qualified Data.ByteString.Char8         as BS8
+import           Data.Function
 import qualified Data.List.NonEmpty            as NonEmpty
 import qualified Data.Yaml                     as YAML
 
@@ -37,6 +39,7 @@ import           Fission.User.Username.Types
 import           Web.DID.Types
 
 import qualified Fission.CLI.Display.Error     as CLI.Error
+import           Fission.CLI.Error.Types
 import           Fission.CLI.IPFS.Peers        as Peers
 import           Fission.CLI.Key.Store         as KeyStore
 import qualified Fission.CLI.YAML              as YAML
@@ -194,3 +197,21 @@ fetchServerDID fissionURL = do
         Right serverDID -> do
           logDebug $ "DID retrieved " <> textDisplay serverDID
           return serverDID
+
+alreadySetup ::
+  ( MonadRescue      m
+  , MonadLogger      m
+  , MonadIO          m
+  , MonadEnvironment m
+  , m `Raises` YAML.ParseException
+  , m `Raises` NotFound FilePath
+  , m `Raises` NotSetup
+  )
+  => m ()
+alreadySetup =
+  attemptM get \case
+    Left _ ->
+      raise NotSetup
+
+    Right _ ->
+      return ()
diff --git a/fission-cli/library/Fission/CLI/Error/Types.hs b/fission-cli/library/Fission/CLI/Error/Types.hs
@@ -1,5 +1,6 @@
 module Fission.CLI.Error.Types
   ( NotRegistered (..)
+  , NotSetup      (..)
   , NoKeyFile     (..)
   ) where
 
@@ -13,6 +14,14 @@ instance Display NotRegistered where
 
 ----------
 
+data NotSetup = NotSetup
+  deriving (Show, Eq, Exception)
+
+instance Display NotSetup where
+  display NotSetup = "Not setup"
+
+----------
+
 data NoKeyFile = NoKeyFile
   deriving (Show, Eq, Exception)
 

diff --git a/fission-cli/library/Fission/CLI/Handler/App/Publish.hs b/fission-cli/library/Fission/CLI/Handler/App/Publish.hs
@@ -125,7 +125,15 @@ publish
           logUser @Text "✈️  Pushing to remote"
           retryOnStatus [status502] 100 (runUpdate cid) >>= \case
             Left err -> do
-              CLI.Error.put err "Server unable to sync data"
+              let errMsg =
+                    case err of
+                      FailureResponse _ (responseStatusCode -> status) | status == status404 ->
+                        "The app has not yet been registered. Please delete your fission.yaml and run `fission app register --name some-name`"
+
+                      _ ->
+                        "Server unable to sync data"
+
+              CLI.Error.put err errMsg
               raise err
 
             Right _ -> do

diff --git a/fission-cli/library/Fission/CLI/Handler/Error/Types.hs b/fission-cli/library/Fission/CLI/Handler/Error/Types.hs
@@ -84,6 +84,7 @@ type Errs
      , NotFound URL
      , NotFound [IPFS.Peer]
      , NotRegistered
+     , NotSetup
      --
      , OS.Unsupported
      , RSA.Error

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.hs b/fission-cli/library/Fission/CLI/Handler/User.hs
@@ -3,6 +3,11 @@ module Fission.CLI.Handler.User (interpret) where
 import           Fission.Prelude
 
 import qualified Fission.CLI.Base.Types                      as Base
+
+import qualified Fission.CLI.Display.Error                   as CLI.Error
+import           Fission.CLI.Error.Types
+
+import           Fission.CLI.Environment                     as Env
 import           Fission.CLI.Types
 
 import qualified Fission.CLI.Handler                         as Handler
@@ -29,4 +34,15 @@ interpret cmd = do
       return ()
 
     WhoAmI _ ->
-      Handler.whoami
+      attemptM Env.alreadySetup \case
+        Left errs ->
+          case openUnionMatch @NotSetup errs of
+            Just err -> do
+              CLI.Error.put err "Fission is installed, but you are not logged in. Please run `fission login`"
+              raise errs
+
+            Nothing ->
+              raise errs
+
+        Right _ ->
+          Handler.whoami
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-cli/library/Fission/CLI/Types.hs b/fission-cli/library/Fission/CLI/Types.hs
@@ -191,13 +191,13 @@ instance
   , Display (OpenUnion errs)
   , IsMember SomeException errs
 
-  , HasField' "httpManager" cfg HTTP.Manager
+  , HasField' "tlsManager"  cfg HTTP.Manager
   , HasLogFunc              cfg
   )
   => MonadGitHub (FissionCLI errs cfg) where
   sendRequest req =
     CLI.withLoader 50_000 do
-      manager <- asks $ getField @"httpManager"
+      manager <- asks $ getField @"tlsManager"
 
       logDebug @Text "🐱🐙 Making request to GitHub"
       liftIO . runClientM req . mkClientEnv manager $ BaseUrl Https "github.com" 443 ""

diff --git a/fission-cli/package.yaml b/fission-cli/package.yaml
@@ -1,5 +1,5 @@
 name: fission-cli
-version: '2.17.0.0'
+version: "2.17.1.0"
 category: CLI
 author:
   - Brooklyn Zelenka

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