Save files in IPFS

csdc-api/src/CSDC/DAO.hs

@@ -8,6 +8,7 @@ import CSDC.Image
 import CSDC.Prelude
 import CSDC.Types.File
 
+import qualified CSDC.IPFS as IPFS
 import qualified CSDC.Mail as Mail
 import qualified CSDC.Mail.Templates as Mail.Templates
 import qualified CSDC.SQL.Files as SQL.Files
@@ -23,11 +24,13 @@ import qualified CSDC.SQL.Units as SQL.Units
 
 import Control.Monad (forM_)
 import Control.Monad.Reader (asks)
+import Data.ByteString (ByteString)
 import Data.Password.Bcrypt (mkPassword, hashPassword)
 import Data.Time.Clock.POSIX (getPOSIXTime)
 import System.FilePath
 
 import qualified Data.Text as Text
+import qualified UnliftIO.Async
 
 --------------------------------------------------------------------------------
 -- User
@@ -388,6 +391,7 @@ insertUnitFile :: Id Unit -> File -> Action user ()
 insertUnitFile i file = do
   let fileFolder = "unit" <> "/" <> Text.pack (show i)
   filedb <- toNewFileDB fileFolder file
+  _ <- UnliftIO.Async.async $ saveFileIPFS (newFileDB_hash filedb) file
   runQuery SQL.Files.upsertFile filedb
 
 getUnitFiles :: Id Unit -> Action user [FileUI]
@@ -398,10 +402,16 @@ getUnitFiles i = do
         { fileUI_path = fileDB_folder <> "/" <> fileDB_name
         , fileUI_name = fileDB_name
         , fileUI_size = fileDB_size
+        , fileUI_ipfs = fileDB_ipfs
         , fileUI_modifiedAt = fileDB_modifiedAt
         }
   pure $ fmap toFileUI filesDB
 
+saveFileIPFS :: ByteString -> File -> Action user ()
+saveFileIPFS hash (File name contents) = do
+  IPFS.CID cid <- runIPFS $ IPFS.add name contents
+  runQuery SQL.Files.updateFileIPFS (hash, cid)
+
 --------------------------------------------------------------------------------
 -- Forum
 

csdc-api/src/CSDC/IPFS.hs

@@ -18,7 +18,7 @@ import CSDC.Prelude
 import Control.Exception (throwIO)
 import Control.Monad.Reader
 import Data.Aeson (encode)
-import Data.ByteString.Lazy (ByteString)
+import Data.ByteString (ByteString)
 import Network.IPFS (MonadLocalIPFS (..))
 import Network.IPFS.Add (addFile)
 import Network.IPFS.CID.Types (CID (..))
@@ -28,6 +28,7 @@ import System.Process.Typed
 import System.Exit
 
 import qualified Data.ByteString.Lazy as Lazy
+import qualified Data.Text as Text
 
 --------------------------------------------------------------------------------
 -- Config
@@ -76,11 +77,11 @@ instance MonadLocalIPFS Action where
         | otherwise ->
           return . Left $ UnknownErr stdErr
 
-add :: FilePath -> ByteString -> Action CID
+add :: Text -> ByteString -> Action CID
 add path bs =
-  addFile bs (Name path) >>= \case
+  addFile (Lazy.fromStrict bs) (Name (Text.unpack path)) >>= \case
     Left e -> liftIO $ throwIO e
     Right (_,a) -> pure a
 
-addJSON :: ToJSON a => FilePath -> a -> Action CID
-addJSON path a = add path (encode a)
+addJSON :: ToJSON a => Text -> a -> Action CID
+addJSON path a = add path $ Lazy.toStrict $ encode a

csdc-api/src/CSDC/SQL/Files.hs

@@ -5,6 +5,7 @@ module CSDC.SQL.Files
   ( selectFile
   , selectFileContents
   , upsertFile
+  , updateFileIPFS
   , selectFolderFiles
   , selectFolderSubfolders
   ) where
@@ -29,7 +30,7 @@ selectFile :: Statement (Text,Text) (Maybe FileDB)
 selectFile = Statement sql encoder decoder True
   where
     sql = ByteString.unlines
-      [ "SELECT folder, name, size, hash, modified_at"
+      [ "SELECT folder, name, size, hash, ipfs, modified_at"
       , "FROM files"
       , "WHERE folder = $1 AND name = $2"
       ]
@@ -43,6 +44,7 @@ selectFile = Statement sql encoder decoder True
       fileDB_name <- Decoder.text
       fileDB_size <- Decoder.int
       fileDB_hash <- Decoder.bytea
+      fileDB_ipfs <- Decoder.textNullable
       fileDB_modifiedAt <- Decoder.posixTime
       pure FileDB {..}
 
@@ -78,14 +80,27 @@ upsertFile = Statement sql encoder Decoders.noResult True
       contramap newFileDB_size Encoder.int <>
       contramap newFileDB_hash Encoder.bytea
 
+updateFileIPFS :: Statement (ByteString, Text) ()
+updateFileIPFS = Statement sql encoder Decoders.noResult True
+  where
+    sql = ByteString.unlines
+      [ "UPDATE files "
+      , "SET ipfs = $2"
+      , "WHERE hash = $1"
+      ]
+
+    encoder =
+      contramap fst Encoder.bytea <>
+      contramap snd Encoder.text
+
 --------------------------------------------------------------------------------
 -- Folders
 
 selectFolderFiles :: Statement Text [FileDB]
 selectFolderFiles = Statement sql encoder decoder True
   where
     sql = ByteString.unlines
-      [ "SELECT folder, name, size, hash, modified_at"
+      [ "SELECT folder, name, size, hash, ipfs, modified_at"
       , "FROM files"
       , "WHERE folder = $1"
       , "ORDER BY name"
@@ -98,6 +113,7 @@ selectFolderFiles = Statement sql encoder decoder True
       fileDB_name <- Decoder.text
       fileDB_size <- Decoder.int
       fileDB_hash <- Decoder.bytea
+      fileDB_ipfs <- Decoder.textNullable
       fileDB_modifiedAt <- Decoder.posixTime
       pure FileDB {..}
 

csdc-base/src/CSDC/Types/File.hs

@@ -88,6 +88,7 @@ data FileDB = FileDB
   , fileDB_name :: Text
   , fileDB_size :: Int
   , fileDB_hash :: ByteString
+  , fileDB_ipfs :: Maybe Text
   , fileDB_modifiedAt :: POSIXTime
   } deriving (Show, Eq)
 
@@ -96,6 +97,7 @@ data FileUI = FileUI
   { fileUI_path :: Text
   , fileUI_name :: Text
   , fileUI_size :: Int
+  , fileUI_ipfs :: Maybe Text
   , fileUI_modifiedAt :: POSIXTime
   } deriving (Show, Eq, Generic)
     deriving (FromJSON, ToJSON) via JSON FileUI

csdc-gui/src/Types.elm

@@ -614,15 +614,17 @@ type alias FileUI =
   { path : FilePath
   , name : String
   , size : Int
+  , ipfs : Maybe String
   , modifiedAt : Posix
   }
 
 decodeFileUI : Decoder FileUI
 decodeFileUI =
-  Decoder.map4 FileUI
+  Decoder.map5 FileUI
     (Decoder.field "path" decodeFilePath)
     (Decoder.field "name" Decoder.string)
     (Decoder.field "size" Decoder.int)
+    (Decoder.field "ipfs" (Decoder.nullable Decoder.string))
     (Decoder.field "modifiedAt" decodePosix)
 
 --------------------------------------------------------------------------------

csdc-gui/src/UI/BoxFile.elm

@@ -19,7 +19,25 @@ view file =
           [ Html.strong [] [ Html.text file.name ]
           ]
       , Html.br [] []
-      , Html.text <| "Size: " ++ String.fromInt file.size
+      , Html.div
+          [ Html.Attributes.style "width" "100%"
+          , Html.Attributes.style "display" "flex"
+          , Html.Attributes.style "justify-content" "space-between"
+          ]
+          [ Html.div [] [Html.text <| "Size: " ++ String.fromInt file.size]
+          , case file.ipfs of
+              Nothing -> Html.div [] []
+              Just ipfs ->
+                Html.div []
+                  [ Html.a
+                      [ Html.Attributes.href <| "https://ipfs.io/ipfs/" ++ ipfs
+                      , Html.Attributes.download file.name
+                      ]
+                      [ Html.strong [] [ Html.text "IPFS Link" ]
+                      ]
+                  ]
+          ]
+
       ]
   in
     BoxItem.view

database/migrations/001-ipfs.sql

@@ -0,0 +1,2 @@
+ALTER TABLE files
+ADD COLUMN ipfs text;