files: file description types (#631)

package.yaml

@@ -71,6 +71,7 @@ dependencies:
   - x509 == 1.7.*
   - x509-store == 1.6.*
   - x509-validation == 1.6.*
+  - yaml == 0.11.*
 
 flags:
   swift:

simplexmq.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.0.
+-- This file has been generated from package.yaml by hpack version 0.35.1.
 --
 -- see: https://github.com/sol/hpack
 
@@ -165,6 +165,7 @@ library
     , x509 ==1.7.*
     , x509-store ==1.6.*
     , x509-validation ==1.6.*
+    , yaml ==0.11.*
   default-language: Haskell2010
   if flag(swift)
     cpp-options: -DswiftJSON
@@ -227,6 +228,7 @@ executable ntf-server
     , x509 ==1.7.*
     , x509-store ==1.6.*
     , x509-validation ==1.6.*
+    , yaml ==0.11.*
   default-language: Haskell2010
   if flag(swift)
     cpp-options: -DswiftJSON
@@ -289,6 +291,7 @@ executable smp-agent
     , x509 ==1.7.*
     , x509-store ==1.6.*
     , x509-validation ==1.6.*
+    , yaml ==0.11.*
   default-language: Haskell2010
   if flag(swift)
     cpp-options: -DswiftJSON
@@ -351,6 +354,7 @@ executable smp-server
     , x509 ==1.7.*
     , x509-store ==1.6.*
     , x509-validation ==1.6.*
+    , yaml ==0.11.*
   default-language: Haskell2010
   if flag(swift)
     cpp-options: -DswiftJSON
@@ -438,6 +442,7 @@ test-suite smp-server-test
     , x509 ==1.7.*
     , x509-store ==1.6.*
     , x509-validation ==1.6.*
+    , yaml ==0.11.*
   default-language: Haskell2010
   if flag(swift)
     cpp-options: -DswiftJSON

src/Simplex/FileTransfer/Description.hs

@@ -1 +1,91 @@
-module Simplex.FileTransfer.Description where
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module Simplex.FileTransfer.Description
+  ( FileDescription (..),
+    FileDigest (..),
+    FileChunk (..),
+    FileChunkReplica (..),
+    YAMLFileDescription (..),
+    YAMLFilePart (..),
+  )
+where
+
+import Data.Aeson (FromJSON, ToJSON)
+import Data.ByteString.Char8 (ByteString)
+import Data.Int (Int64)
+import Data.Word (Word32)
+import qualified Data.Yaml as Y
+import GHC.Generics (Generic)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding.String
+
+data FileDescription = FileDescription
+  { name :: String,
+    size :: Int64,
+    digest :: FileDigest,
+    encKey :: C.Key,
+    iv :: C.IV,
+    chunks :: [FileChunk]
+  }
+  deriving (Show)
+
+newtype FileDigest = FileDigest {unFileDigest :: ByteString}
+  deriving (Eq, Show)
+
+instance StrEncoding FileDigest where
+  strEncode (FileDigest fd) = strEncode fd
+  strDecode s = FileDigest <$> strDecode s
+  strP = FileDigest <$> strP
+
+instance FromJSON FileDigest where
+  parseJSON = strParseJSON "FileDigest"
+
+instance ToJSON FileDigest where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding
+
+data FileChunk = FileChunk
+  { chunkNo :: Int,
+    digest :: ByteString,
+    chunkSize :: Word32,
+    replicas :: [FileChunkReplica]
+  }
+  deriving (Show)
+
+data FileChunkReplica = FileChunkReplica
+  { server :: String,
+    rcvId :: ByteString,
+    rcvKey :: C.APrivateSignKey
+  }
+  deriving (Show)
+
+data YAMLFileDescription = YAMLFileDescription
+  { name :: String,
+    size :: Int64,
+    chunkSize :: Word32,
+    digest :: FileDigest,
+    encKey :: C.Key,
+    iv :: C.IV,
+    parts :: [YAMLFilePart]
+  }
+  deriving (Eq, Show, Generic)
+
+instance FromJSON YAMLFileDescription
+
+data YAMLFilePart = YAMLFilePart
+  { server :: String,
+    chunks :: [String]
+  }
+  deriving (Eq, Show, Generic)
+
+instance FromJSON YAMLFilePart
+
+data FilePartChunk = FilePartChunk
+  { chunkNo :: Int,
+    rcvId :: ByteString,
+    rcvKey :: C.APrivateSignKey,
+    digest :: Maybe ByteString,
+    chunkSize :: Maybe Word32
+  }
+  deriving (Show)

src/Simplex/Messaging/Crypto.hs

@@ -742,11 +742,19 @@ instance FromJSON Key where
 
 -- | IV bytes newtype.
 newtype IV = IV {unIV :: ByteString}
+  deriving (Eq, Show)
 
 instance Encoding IV where
   smpEncode = unIV
   smpP = IV <$> A.take (ivSize @AES256)
 
+instance ToJSON IV where
+  toJSON = strToJSON . unIV
+  toEncoding = strToJEncoding . unIV
+
+instance FromJSON IV where
+  parseJSON = fmap IV . strParseJSON "IV"
+
 newtype AuthTag = AuthTag {unAuthTag :: AES.AuthTag}
 
 instance Encoding AuthTag where

tests/FileDescriptionTests.hs

@@ -0,0 +1,8 @@
+module FileDescriptionTests where
+
+import Test.Hspec
+
+fileDescriptionTests :: Spec
+fileDescriptionTests =
+  describe "file description parsing / rendering" $ do
+    pure ()

tests/Test.hs

@@ -8,6 +8,7 @@ import CoreTests.EncodingTests
 import CoreTests.ProtocolErrorTests
 import CoreTests.RetryIntervalTests
 import CoreTests.VersionRangeTests
+import FileDescriptionTests (fileDescriptionTests)
 import NtfServerTests (ntfServerTests)
 import ServerTests
 import Simplex.Messaging.Transport (TLS, Transport (..))
@@ -40,3 +41,4 @@ main = do
         describe "Notifications server" $ ntfServerTests (transport @TLS)
         describe "SMP client agent" $ agentTests (transport @TLS)
         describe "Server CLIs" cliTests
+        describe "File description" fileDescriptionTests

tests/fixtures/file_description.yaml

@@ -0,0 +1,15 @@
+name: file.ext
+size: 33200000
+chunk: 8mb
+hash: abc=
+key: abc=
+iv: abc=
+parts:
+  - server: xftp://abc=@example1.com
+    chunks: [1:abc=:def=:ghi=, 3:abc=:def=:ghi=]
+  - server: xftp://abc=@example2.com
+    chunks: [2:abc=:def=:ghi=, 4:abc=:def=:ghi=:2mb]
+  - server: xftp://abc=@example3.com
+    chunks: [1:abc=:def=, 4:abc=:def=]
+  - server: xftp://abc=@example4.com
+    chunks: [2:abc=:def=, 3:abc=:def=]