Add Append Endpoint (#595)

* Bump server version to 2.20.0.0

* Add append endpoint to Web API

* Add DirectoryName and FileName modules

* Append endpoint DAG surgery (#608)

* Implement add file to app endpoint

* Add some notes to the readme

* Rewrite IPFS files stats to handle more than CIDs

* Use multipart upload instead of octetstream

* Retrieve domain and update DNSLink

* Use domain name from ENV

* Append to uploads directory

* Return CID of appended file

* Validate UCAN resource (#621)

Co-authored-by: Steven Vandevelde <[email protected]>

fission-cli/library/Fission/CLI/Handler/App/Delegate.hs

@@ -62,7 +62,7 @@ import           Web.UCAN.Validation                              (check)
 -- | Delegate capabilities to a DID
 delegate ::
   ( MonadIO          m
-  , MonadLogger      m 
+  , MonadLogger      m
   , MonadRandom      m
   , MonadTime        m
 
@@ -109,12 +109,13 @@ delegate appName potency audienceDid lifetimeInSeconds (QuietFlag quiet) = do
         raise $ ParseError @DID
 
       Right did -> do
-        remoteUrl <- getRemoteURL
-        logDebug $ "Remote URL: " <> show remoteUrl
+        appUrl <- getAppDomain
+
+        logDebug $ "Application domain: " <> show appUrl
 
         let
-          URL { domainName } = remoteUrl
-          url = URL { domainName, subdomain = Just $ Subdomain appName}
+          URL { domainName } = appUrl
+          url = URL { domainName, subdomain = Just $ Subdomain appName }
           appResource = Subset $ FissionApp (Subset url)
 
         ptc <- case potency of
@@ -132,7 +133,7 @@ delegate appName potency audienceDid lifetimeInSeconds (QuietFlag quiet) = do
           Right (signingKey, proof) -> do
             now <- getCurrentTime
 
-            let 
+            let
               ucan = UCAN.delegateWithLifetime did signingKey appResource ptc proof lifetimeInSeconds now
               encodedUcan = encodeUcan ucan
 
@@ -147,7 +148,7 @@ delegate appName potency audienceDid lifetimeInSeconds (QuietFlag quiet) = do
 
 getCredentialsFor ::
   ( MonadIO          m
-  , MonadLogger      m 
+  , MonadLogger      m
   , MonadRandom      m
   , MonadTime        m
 
@@ -175,8 +176,8 @@ getCredentialsFor ::
 
   , Contains (Errors m) (Errors m)
   , Show     (OpenUnion (Errors m))
-  ) 
-  => Text 
+  )
+  => Text
   -> Scope Resource
   -> Potency
   -> m (SecretKey SigningKey, Proof)
@@ -253,15 +254,15 @@ checkProofEnvVar ::
   -> DID
   -> Scope Resource
   -> Potency
-  -> m UCAN 
+  -> m UCAN
 checkProofEnvVar token did resource potency = do
   let tokenBS = Char8.pack $ wrapIn "\"" token
 
   case UCAN.parse tokenBS of
     Left err -> do
       CLI.Error.put err "Unable to parse UCAN set in FISSION_APP_UCAN environment variable"
       raise $ ParseError @UCAN
-          
+
     Right ucan -> do
       let rawContent = UCAN.RawContent.contentOf (decodeUtf8Lenient tokenBS)
       capableUcan <- ensureM $ checkCapability resource potency ucan
@@ -293,7 +294,7 @@ checkProofConfig ::
   -> Text
   -> Scope Resource
   -> Potency
-  -> m Proof 
+  -> m Proof
 checkProofConfig proof did appName appResource potency = do
   case proof of
     UCAN.Types.RootCredential -> do
@@ -315,7 +316,7 @@ checkProofConfig proof did appName appResource potency = do
       ucan <- ensure $ parseToken proofTokenBS
 
       capableUcan <- ensureM $ checkCapability appResource potency ucan
-      ensureM $ check did rawContent capableUcan 
+      ensureM $ check did rawContent capableUcan
       return proof
 
 checkCapability ::
@@ -356,9 +357,9 @@ checkCapability requestedResource requestedPotency ucan = do
       putScopeError
       return $ Left ScopeOutOfBounds
 
-checkAppRegistration :: 
+checkAppRegistration ::
   ( MonadIO          m
-  , MonadLogger      m 
+  , MonadLogger      m
   , MonadTime        m
   , MonadWebClient   m
   , ServerDID        m
@@ -373,8 +374,8 @@ checkAppRegistration ::
   , Contains (Errors m) (Errors m)
   , Show     (OpenUnion (Errors m))
   )
-  => Text 
-  -> Proof 
+  => Text
+  -> Proof
   -> m (Either (ErrorCase m) Bool)
 checkAppRegistration appName proof = do
   attempt (sendAuthedRequest proof appIndex) >>= \case

fission-cli/library/Fission/CLI/Handler/Error/Types.hs

@@ -10,6 +10,7 @@ import qualified Crypto.PubKey.RSA.Types                   as RSA
 
 import           Network.DNS                               as DNS
 import qualified Network.IPFS.Add.Error                    as IPFS.Add
+import qualified Network.IPFS.Files.Error              as IPFS.Files
 import           Network.IPFS.CID.Types
 import qualified Network.IPFS.Process.Error                as IPFS.Process
 import qualified Network.IPFS.Types                        as IPFS
@@ -62,6 +63,7 @@ type Errs
      , Status Denied
      --
      , IPFS.Add.Error
+     , IPFS.Files.Error
      , IPFS.Process.Error
      , IPFS.UnableToConnect
      --

fission-cli/library/Fission/CLI/Remote.hs

@@ -1,5 +1,6 @@
 module Fission.CLI.Remote
-  ( getRemoteURL
+  ( getAppDomain
+  , getRemoteURL
   , getRemoteBaseUrl
   , getNameService
   , getIpfsGateway
@@ -17,6 +18,9 @@ import           Fission.Web.API.Remote
 
 import           Fission.CLI.Remote.Class
 
+getAppDomain :: MonadRemote m => m URL
+getAppDomain = toAppDomain <$> getRemote
+
 getRemoteBaseUrl :: MonadRemote m => m BaseUrl
 getRemoteBaseUrl = toBaseUrl <$> getRemote
 

fission-core/library/Fission/FileSystem/DirectoryName.hs

@@ -0,0 +1,3 @@
+module Fission.FileSystem.DirectoryName (module Fission.FileSystem.DirectoryName.Types) where
+
+import           Fission.FileSystem.DirectoryName.Types

fission-core/library/Fission/FileSystem/DirectoryName/Error.hs

@@ -0,0 +1,13 @@
+-- | Directory name errors
+module Fission.FileSystem.DirectoryName.Error (Invalid (..)) where
+
+import           Fission.Prelude
+
+data Invalid = Invalid
+  deriving ( Show
+           , Eq
+           , Exception
+           )
+
+instance Display Invalid where
+  display Invalid = "Invalid directory name -- must be alphanumeric separated with hyphens and not blocklisted"

fission-core/library/Fission/FileSystem/DirectoryName/Types.hs

@@ -0,0 +1,44 @@
+module Fission.FileSystem.DirectoryName.Types (DirectoryName (..)) where
+
+import           RIO.Text                   as Text
+
+import           Data.Swagger
+import           Servant.API
+
+import           Fission.Prelude
+
+import           Fission.URL.Validation
+
+import           Fission.FileSystem.DirectoryName.Error
+
+newtype DirectoryName = DirectoryName { directoryName :: Text }
+  deriving          ( Generic )
+  deriving anyclass ( ToSchema
+                    , ToParamSchema
+                    )
+  deriving newtype  ( Eq
+                    , Show
+                    , IsString
+                    )
+
+mkDirectoryName :: Text -> Either Invalid DirectoryName
+mkDirectoryName txt =
+  if isValid normalized
+    then Right $ DirectoryName normalized
+    else Left Invalid
+
+  where
+    normalized = Text.toLower txt
+
+instance Arbitrary DirectoryName where
+  arbitrary = do
+    txt <- arbitrary
+    case mkDirectoryName $ Text.filter isURLChar txt of
+      Left _      -> arbitrary
+      Right dName -> return dName
+
+instance FromHttpApiData DirectoryName where
+  parseUrlPiece = Right . DirectoryName
+
+instance ToHttpApiData DirectoryName where
+  toUrlPiece (DirectoryName directoryName) = directoryName

fission-core/library/Fission/FileSystem/FileName.hs

@@ -0,0 +1,3 @@
+module Fission.FileSystem.FileName (module Fission.FileSystem.FileName.Types) where
+
+import           Fission.FileSystem.FileName.Types

fission-core/library/Fission/FileSystem/FileName/Error.hs

@@ -0,0 +1,13 @@
+-- | File name errors
+module Fission.FileSystem.FileName.Error (Invalid (..)) where
+
+import           Fission.Prelude
+
+data Invalid = Invalid
+  deriving ( Show
+           , Eq
+           , Exception
+           )
+
+instance Display Invalid where
+  display Invalid = "Invalid file name -- must be alphanumeric separated with hyphens and not blocklisted"

fission-core/library/Fission/FileSystem/FileName/Types.hs

@@ -0,0 +1,45 @@
+module Fission.FileSystem.FileName.Types (FileName (..)) where
+
+import           RIO.Text                   as Text
+
+import           Data.Swagger
+import           Servant.API
+
+import           Fission.Prelude
+
+import           Fission.URL.Validation
+
+import           Fission.FileSystem.FileName.Error
+
+
+newtype FileName = FileName { fileName :: Text }
+  deriving          ( Generic )
+  deriving anyclass ( ToSchema
+                    , ToParamSchema
+                    )
+  deriving newtype  ( Eq
+                    , Show
+                    , IsString
+                    )
+
+mkDirectoryName :: Text -> Either Invalid FileName
+mkDirectoryName txt =
+  if isValid normalized
+    then Right $ FileName normalized
+    else Left Invalid
+
+  where
+    normalized = Text.toLower txt
+
+instance Arbitrary FileName where
+  arbitrary = do
+    txt <- arbitrary
+    case mkDirectoryName $ Text.filter isURLChar txt of
+      Left _      -> arbitrary
+      Right dName -> return dName
+
+instance FromHttpApiData FileName where
+  parseUrlPiece = Right . FileName
+
+instance ToHttpApiData FileName where
+  toUrlPiece (FileName fileName) = fileName

fission-core/library/Fission/Web/Auth/Token/UCAN/Resource/Types.hs

@@ -2,7 +2,8 @@ module Fission.Web.Auth.Token.UCAN.Resource.Types (Resource (..)) where
 
 import           Fission.Prelude
 
-import           Fission.URL
+import           Fission.URL.DomainName.Types ( DomainName )
+import           Fission.URL.Types ( URL )
 import           Fission.Web.Auth.Token.UCAN.Resource.Scope.Types
 
 import qualified Data.Bits                                        as Bits

fission-web-api/library/Fission/Web/API/Append/Types.hs

@@ -0,0 +1,27 @@
+module Fission.Web.API.Append.Types (RoutesV2 (..)) where
+
+import           Network.IPFS.File.Types                 as File
+import           Network.IPFS.CID.Types
+
+import           Fission.Web.API.Prelude
+
+import qualified Fission.Web.API.Auth.Types              as Auth
+
+import           Fission.FileSystem.DirectoryName.Types  as DirectoryName
+import           Fission.FileSystem.FileName.Types       as FileName
+
+newtype RoutesV2 mode = RoutesV2
+  { append ::
+      mode
+      :- Summary     "Append a file"
+      :> Description "Append a file to an app's public upload directory"
+      --
+      :> Capture    "App Name"  DirectoryName
+      :> Capture    "File Name" FileName
+      --
+      :> ReqBody '[OctetStream] Serialized
+      --
+      :> Auth.HigherOrder
+      :> PutAccepted '[JSON] CID
+  }
+  deriving Generic

fission-web-api/library/Fission/Web/API/Remote.hs

@@ -1,6 +1,7 @@
 module Fission.Web.API.Remote
   ( Remote (..)
   , fromText
+  , toAppDomain
   , toBaseUrl
   , toURL
   , toNameService
@@ -51,6 +52,17 @@ fromText txt =
 
     custom        -> Custom <$> parseBaseUrl (Text.unpack custom)
 
+toAppDomain :: Remote -> URL
+toAppDomain = \case
+  Production -> URL "fission.app"    Nothing
+  Staging    -> URL "fissionapp.net" Nothing
+  LocalDev   -> URL "localhost"      Nothing
+  Custom url ->
+    if Text.isSuffixOf ".test" (textDisplay $ baseUrlHost url) then
+      URL "fissionapp.test" Nothing
+    else
+      URL.fromBaseUrl url
+
 toBaseUrl :: Remote -> BaseUrl
 toBaseUrl = \case
   Production -> production

fission-web-api/library/Fission/Web/API/Types.hs

@@ -14,6 +14,7 @@ import qualified Fission.Pong.Types              as Ping
 import           Fission.Web.API.Prelude
 
 import qualified Fission.Web.API.App.Types       as App
+import qualified Fission.Web.API.Append.Types    as Append
 import qualified Fission.Web.API.Auth.UCAN.Types as UCAN
 import qualified Fission.Web.API.DNS.Types       as DNS
 import           Fission.Web.API.Docs
@@ -39,10 +40,11 @@ data RoutesV2 mode = RoutesV2
   deriving Generic
 
 data V2 mode = V2
-  { ipfs :: mode :- "ipfs"           :> ToServantApi IPFS.RoutesV2
-  , app  :: mode :- "app"            :> ToServantApi App.RoutesV2
-  , user :: mode :- "user"           :> ToServantApi User.RoutesV2
-  , auth :: mode :- "auth" :> "ucan" :> ToServantApi UCAN.Routes
+  { ipfs   :: mode :- "ipfs"           :> ToServantApi IPFS.RoutesV2
+  , app    :: mode :- "app"            :> ToServantApi App.RoutesV2
+  , user   :: mode :- "user"           :> ToServantApi User.RoutesV2
+  , auth   :: mode :- "auth" :> "ucan" :> ToServantApi UCAN.Routes
+  , append :: mode :- "append"         :> ToServantApi Append.RoutesV2
   }
   deriving Generic
 

fission-web-server/README.md

@@ -57,7 +57,7 @@ To mimic the full "fission stack" for local development, you can use the include
    - `docker compose exec dns-auth pdnsutil add-record fissionuser.test. gateway A "127.0.0.1"`
    - `docker compose exec dns-auth pdnsutil add-record fissionapp.test. gateway A "127.0.0.1"`
 5. Point your local DNS resolver to localhost.
-   - on macOS: this is under System Preferences > Network > Advanced.
+   - on macOS: this is under System Preferences > Network > Advanced (make sure your local IP is at the top of the list)
    - on Linux: Add `nameserver 127.0.0.1` to `/etc/resolv.conf`
 6. Pin the CID for the new app placeholder:
    `docker compose exec ipfs ipfs pin add -r QmRVvvMeMEPi1zerpXYH9df3ATdzuB63R1wf3Mz5NS5HQN`
@@ -84,4 +84,10 @@ runfission.test.        3600    IN      SOA     a.misconfigured.dns.server.inval
 If you don't see that, you can try the following steps:
 1. Ensure the local DNS server is set up for the zone, e.g. `dig runfission.test -p 5300 @127.0.0.1`. If that fails, make sure the zone is created (see above).
 2. Ensure the local resolver is working, e.g. `dig runfission.test @127.0.0.1`. If that fails, make sure the zone exists in `.env`.
-3. If `dig runfission.test` still fails, ensure your system is set to use the local resolver. Also, try disabling any VPN software (Tailscale, etc) as they may conflict with DNS resolution.
+3. If `dig runfission.test` still fails, ensure your system is set to use the local resolver. Also, try disabling any VPN software (Tailscale, etc) as they may conflict with DNS resolution.
+
+#### Practical
+
+- Connecting to the database: `docker compose exec postgres psql`
+- You can lookup DNSLinks using `dig -t TXT _dnslink.HOST` (eg. `dig -t TXT _dnslink.icidasset.files.fissionuser.test`)
+- Interacting with the IPFS CLI connected to the IPFS daemon: `docker compose exec ipfs ipfs ...`