{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

module Simplex.FileTransfer.Description
  ( FileDescription (..),
    RedirectFileInfo (..),
    AFileDescription (..),
    ValidFileDescription, -- constructor is not exported, use pattern
    pattern ValidFileDescription,
    AValidFileDescription (..),
    FileDigest (..),
    FileChunk (..),
    FileChunkReplica (..),
    FileServerReplica (..),
    FileSize (..),
    ChunkReplicaId (..),
    YAMLFileDescription (..), -- for tests
    YAMLServerReplicas (..), -- for tests
    validateFileDescription,
    groupReplicasByServer,
    fdSeparator,
    kb,
    mb,
    gb,
    FileDescriptionURI (..),
    FileClientData,
    fileDescriptionURI,
    qrSizeLimit,
    maxFileSize,
    maxFileSizeStr,
    maxFileSizeHard,
    fileSizeLen,
  )
where

import Control.Applicative (optional)
import Control.Monad ((<=<))
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.Aeson as J
import qualified Data.Aeson.TH as J
import Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Bifunctor (first)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64)
import Data.List (foldl', sortOn)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe)
import Data.String
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word32)
import qualified Data.Yaml as Y
import Simplex.FileTransfer.Chunks
import Simplex.FileTransfer.Protocol
import Simplex.Messaging.Agent.QueryString
import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..))
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, parseAll)
import Simplex.Messaging.Protocol (XFTPServer)
import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
import Simplex.Messaging.Util (bshow, safeDecodeUtf8, (<$?>))

data FileDescription (p :: FileParty) = FileDescription
  { forall (p :: FileParty). FileDescription p -> SFileParty p
party :: SFileParty p,
    forall (p :: FileParty). FileDescription p -> FileSize Int64
size :: FileSize Int64,
    forall (p :: FileParty). FileDescription p -> FileDigest
digest :: FileDigest,
    forall (p :: FileParty). FileDescription p -> SbKey
key :: C.SbKey,
    forall (p :: FileParty). FileDescription p -> CbNonce
nonce :: C.CbNonce,
    forall (p :: FileParty). FileDescription p -> FileSize Word32
chunkSize :: FileSize Word32,
    forall (p :: FileParty). FileDescription p -> [FileChunk]
chunks :: [FileChunk],
    forall (p :: FileParty).
FileDescription p -> Maybe RedirectFileInfo
redirect :: Maybe RedirectFileInfo
  }
  deriving (FileDescription p -> FileDescription p -> Bool
(FileDescription p -> FileDescription p -> Bool)
-> (FileDescription p -> FileDescription p -> Bool)
-> Eq (FileDescription p)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (p :: FileParty).
FileDescription p -> FileDescription p -> Bool
$c== :: forall (p :: FileParty).
FileDescription p -> FileDescription p -> Bool
== :: FileDescription p -> FileDescription p -> Bool
$c/= :: forall (p :: FileParty).
FileDescription p -> FileDescription p -> Bool
/= :: FileDescription p -> FileDescription p -> Bool
Eq, Int -> FileDescription p -> ShowS
[FileDescription p] -> ShowS
FileDescription p -> String
(Int -> FileDescription p -> ShowS)
-> (FileDescription p -> String)
-> ([FileDescription p] -> ShowS)
-> Show (FileDescription p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (p :: FileParty). Int -> FileDescription p -> ShowS
forall (p :: FileParty). [FileDescription p] -> ShowS
forall (p :: FileParty). FileDescription p -> String
$cshowsPrec :: forall (p :: FileParty). Int -> FileDescription p -> ShowS
showsPrec :: Int -> FileDescription p -> ShowS
$cshow :: forall (p :: FileParty). FileDescription p -> String
show :: FileDescription p -> String
$cshowList :: forall (p :: FileParty). [FileDescription p] -> ShowS
showList :: [FileDescription p] -> ShowS
Show)

data RedirectFileInfo = RedirectFileInfo
  { RedirectFileInfo -> FileSize Int64
size :: FileSize Int64,
    RedirectFileInfo -> FileDigest
digest :: FileDigest
  }
  deriving (RedirectFileInfo -> RedirectFileInfo -> Bool
(RedirectFileInfo -> RedirectFileInfo -> Bool)
-> (RedirectFileInfo -> RedirectFileInfo -> Bool)
-> Eq RedirectFileInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RedirectFileInfo -> RedirectFileInfo -> Bool
== :: RedirectFileInfo -> RedirectFileInfo -> Bool
$c/= :: RedirectFileInfo -> RedirectFileInfo -> Bool
/= :: RedirectFileInfo -> RedirectFileInfo -> Bool
Eq, Int -> RedirectFileInfo -> ShowS
[RedirectFileInfo] -> ShowS
RedirectFileInfo -> String
(Int -> RedirectFileInfo -> ShowS)
-> (RedirectFileInfo -> String)
-> ([RedirectFileInfo] -> ShowS)
-> Show RedirectFileInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RedirectFileInfo -> ShowS
showsPrec :: Int -> RedirectFileInfo -> ShowS
$cshow :: RedirectFileInfo -> String
show :: RedirectFileInfo -> String
$cshowList :: [RedirectFileInfo] -> ShowS
showList :: [RedirectFileInfo] -> ShowS
Show)

data AFileDescription = forall p. FilePartyI p => AFD (FileDescription p)

newtype ValidFileDescription p = ValidFD (FileDescription p)
  deriving (ValidFileDescription p -> ValidFileDescription p -> Bool
(ValidFileDescription p -> ValidFileDescription p -> Bool)
-> (ValidFileDescription p -> ValidFileDescription p -> Bool)
-> Eq (ValidFileDescription p)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (p :: FileParty).
ValidFileDescription p -> ValidFileDescription p -> Bool
$c== :: forall (p :: FileParty).
ValidFileDescription p -> ValidFileDescription p -> Bool
== :: ValidFileDescription p -> ValidFileDescription p -> Bool
$c/= :: forall (p :: FileParty).
ValidFileDescription p -> ValidFileDescription p -> Bool
/= :: ValidFileDescription p -> ValidFileDescription p -> Bool
Eq, Int -> ValidFileDescription p -> ShowS
[ValidFileDescription p] -> ShowS
ValidFileDescription p -> String
(Int -> ValidFileDescription p -> ShowS)
-> (ValidFileDescription p -> String)
-> ([ValidFileDescription p] -> ShowS)
-> Show (ValidFileDescription p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (p :: FileParty). Int -> ValidFileDescription p -> ShowS
forall (p :: FileParty). [ValidFileDescription p] -> ShowS
forall (p :: FileParty). ValidFileDescription p -> String
$cshowsPrec :: forall (p :: FileParty). Int -> ValidFileDescription p -> ShowS
showsPrec :: Int -> ValidFileDescription p -> ShowS
$cshow :: forall (p :: FileParty). ValidFileDescription p -> String
show :: ValidFileDescription p -> String
$cshowList :: forall (p :: FileParty). [ValidFileDescription p] -> ShowS
showList :: [ValidFileDescription p] -> ShowS
Show)

pattern ValidFileDescription :: FileDescription p -> ValidFileDescription p
pattern $mValidFileDescription :: forall {r} {p :: FileParty}.
ValidFileDescription p
-> (FileDescription p -> r) -> ((# #) -> r) -> r
$bValidFileDescription :: forall (p :: FileParty).
FileDescription p -> ValidFileDescription p
ValidFileDescription fd = ValidFD fd

{-# COMPLETE ValidFileDescription #-}

data AValidFileDescription = forall p. FilePartyI p => AVFD (ValidFileDescription p)

fdSeparator :: IsString s => s
fdSeparator :: forall s. IsString s => s
fdSeparator = s
"################################\n"

newtype FileDigest = FileDigest {FileDigest -> ByteString
unFileDigest :: ByteString}
  deriving (FileDigest -> FileDigest -> Bool
(FileDigest -> FileDigest -> Bool)
-> (FileDigest -> FileDigest -> Bool) -> Eq FileDigest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileDigest -> FileDigest -> Bool
== :: FileDigest -> FileDigest -> Bool
$c/= :: FileDigest -> FileDigest -> Bool
/= :: FileDigest -> FileDigest -> Bool
Eq, Int -> FileDigest -> ShowS
[FileDigest] -> ShowS
FileDigest -> String
(Int -> FileDigest -> ShowS)
-> (FileDigest -> String)
-> ([FileDigest] -> ShowS)
-> Show FileDigest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileDigest -> ShowS
showsPrec :: Int -> FileDigest -> ShowS
$cshow :: FileDigest -> String
show :: FileDigest -> String
$cshowList :: [FileDigest] -> ShowS
showList :: [FileDigest] -> ShowS
Show)
  deriving newtype (FieldParser FileDigest
FieldParser FileDigest -> FromField FileDigest
forall a. FieldParser a -> FromField a
$cfromField :: FieldParser FileDigest
fromField :: FieldParser FileDigest
FromField)

instance ToField FileDigest where toField :: FileDigest -> SQLData
toField (FileDigest ByteString
s) = Binary ByteString -> SQLData
forall a. ToField a => a -> SQLData
toField (Binary ByteString -> SQLData) -> Binary ByteString -> SQLData
forall a b. (a -> b) -> a -> b
$ ByteString -> Binary ByteString
forall a. a -> Binary a
Binary ByteString
s

instance StrEncoding FileDigest where
  strEncode :: FileDigest -> ByteString
strEncode (FileDigest ByteString
fd) = ByteString -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ByteString
fd
  strDecode :: ByteString -> Either String FileDigest
strDecode ByteString
s = ByteString -> FileDigest
FileDigest (ByteString -> FileDigest)
-> Either String ByteString -> Either String FileDigest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String ByteString
forall a. StrEncoding a => ByteString -> Either String a
strDecode ByteString
s
  strP :: Parser FileDigest
strP = ByteString -> FileDigest
FileDigest (ByteString -> FileDigest)
-> Parser ByteString ByteString -> Parser FileDigest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
forall a. StrEncoding a => Parser a
strP

instance FromJSON FileDigest where
  parseJSON :: Value -> Parser FileDigest
parseJSON = String -> Value -> Parser FileDigest
forall a. StrEncoding a => String -> Value -> Parser a
strParseJSON String
"FileDigest"

instance ToJSON FileDigest where
  toJSON :: FileDigest -> Value
toJSON = FileDigest -> Value
forall a. StrEncoding a => a -> Value
strToJSON
  toEncoding :: FileDigest -> Encoding
toEncoding = FileDigest -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding

data FileChunk = FileChunk
  { FileChunk -> Int
chunkNo :: Int,
    FileChunk -> FileSize Word32
chunkSize :: FileSize Word32,
    FileChunk -> FileDigest
digest :: FileDigest,
    FileChunk -> [FileChunkReplica]
replicas :: [FileChunkReplica]
  }
  deriving (FileChunk -> FileChunk -> Bool
(FileChunk -> FileChunk -> Bool)
-> (FileChunk -> FileChunk -> Bool) -> Eq FileChunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileChunk -> FileChunk -> Bool
== :: FileChunk -> FileChunk -> Bool
$c/= :: FileChunk -> FileChunk -> Bool
/= :: FileChunk -> FileChunk -> Bool
Eq, Int -> FileChunk -> ShowS
[FileChunk] -> ShowS
FileChunk -> String
(Int -> FileChunk -> ShowS)
-> (FileChunk -> String)
-> ([FileChunk] -> ShowS)
-> Show FileChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileChunk -> ShowS
showsPrec :: Int -> FileChunk -> ShowS
$cshow :: FileChunk -> String
show :: FileChunk -> String
$cshowList :: [FileChunk] -> ShowS
showList :: [FileChunk] -> ShowS
Show)

data FileChunkReplica = FileChunkReplica
  { FileChunkReplica -> XFTPServer
server :: XFTPServer,
    FileChunkReplica -> ChunkReplicaId
replicaId :: ChunkReplicaId,
    FileChunkReplica -> APrivateAuthKey
replicaKey :: C.APrivateAuthKey
  }
  deriving (FileChunkReplica -> FileChunkReplica -> Bool
(FileChunkReplica -> FileChunkReplica -> Bool)
-> (FileChunkReplica -> FileChunkReplica -> Bool)
-> Eq FileChunkReplica
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileChunkReplica -> FileChunkReplica -> Bool
== :: FileChunkReplica -> FileChunkReplica -> Bool
$c/= :: FileChunkReplica -> FileChunkReplica -> Bool
/= :: FileChunkReplica -> FileChunkReplica -> Bool
Eq, Int -> FileChunkReplica -> ShowS
[FileChunkReplica] -> ShowS
FileChunkReplica -> String
(Int -> FileChunkReplica -> ShowS)
-> (FileChunkReplica -> String)
-> ([FileChunkReplica] -> ShowS)
-> Show FileChunkReplica
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileChunkReplica -> ShowS
showsPrec :: Int -> FileChunkReplica -> ShowS
$cshow :: FileChunkReplica -> String
show :: FileChunkReplica -> String
$cshowList :: [FileChunkReplica] -> ShowS
showList :: [FileChunkReplica] -> ShowS
Show)

newtype ChunkReplicaId = ChunkReplicaId {ChunkReplicaId -> XFTPFileId
unChunkReplicaId :: XFTPFileId}
  deriving (ChunkReplicaId -> ChunkReplicaId -> Bool
(ChunkReplicaId -> ChunkReplicaId -> Bool)
-> (ChunkReplicaId -> ChunkReplicaId -> Bool) -> Eq ChunkReplicaId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChunkReplicaId -> ChunkReplicaId -> Bool
== :: ChunkReplicaId -> ChunkReplicaId -> Bool
$c/= :: ChunkReplicaId -> ChunkReplicaId -> Bool
/= :: ChunkReplicaId -> ChunkReplicaId -> Bool
Eq, Int -> ChunkReplicaId -> ShowS
[ChunkReplicaId] -> ShowS
ChunkReplicaId -> String
(Int -> ChunkReplicaId -> ShowS)
-> (ChunkReplicaId -> String)
-> ([ChunkReplicaId] -> ShowS)
-> Show ChunkReplicaId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChunkReplicaId -> ShowS
showsPrec :: Int -> ChunkReplicaId -> ShowS
$cshow :: ChunkReplicaId -> String
show :: ChunkReplicaId -> String
$cshowList :: [ChunkReplicaId] -> ShowS
showList :: [ChunkReplicaId] -> ShowS
Show)
  deriving newtype (Parser ChunkReplicaId
ByteString -> Either String ChunkReplicaId
ChunkReplicaId -> ByteString
(ChunkReplicaId -> ByteString)
-> (ByteString -> Either String ChunkReplicaId)
-> Parser ChunkReplicaId
-> StrEncoding ChunkReplicaId
forall a.
(a -> ByteString)
-> (ByteString -> Either String a) -> Parser a -> StrEncoding a
$cstrEncode :: ChunkReplicaId -> ByteString
strEncode :: ChunkReplicaId -> ByteString
$cstrDecode :: ByteString -> Either String ChunkReplicaId
strDecode :: ByteString -> Either String ChunkReplicaId
$cstrP :: Parser ChunkReplicaId
strP :: Parser ChunkReplicaId
StrEncoding)

instance FromJSON ChunkReplicaId where
  parseJSON :: Value -> Parser ChunkReplicaId
parseJSON = String -> Value -> Parser ChunkReplicaId
forall a. StrEncoding a => String -> Value -> Parser a
strParseJSON String
"ChunkReplicaId"

instance ToJSON ChunkReplicaId where
  toJSON :: ChunkReplicaId -> Value
toJSON = ChunkReplicaId -> Value
forall a. StrEncoding a => a -> Value
strToJSON
  toEncoding :: ChunkReplicaId -> Encoding
toEncoding = ChunkReplicaId -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding

data YAMLFileDescription = YAMLFileDescription
  { YAMLFileDescription -> FileParty
party :: FileParty,
    YAMLFileDescription -> String
size :: String,
    YAMLFileDescription -> FileDigest
digest :: FileDigest,
    YAMLFileDescription -> SbKey
key :: C.SbKey,
    YAMLFileDescription -> CbNonce
nonce :: C.CbNonce,
    YAMLFileDescription -> String
chunkSize :: String,
    YAMLFileDescription -> [YAMLServerReplicas]
replicas :: [YAMLServerReplicas],
    YAMLFileDescription -> Maybe RedirectFileInfo
redirect :: Maybe RedirectFileInfo
  }
  deriving (YAMLFileDescription -> YAMLFileDescription -> Bool
(YAMLFileDescription -> YAMLFileDescription -> Bool)
-> (YAMLFileDescription -> YAMLFileDescription -> Bool)
-> Eq YAMLFileDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: YAMLFileDescription -> YAMLFileDescription -> Bool
== :: YAMLFileDescription -> YAMLFileDescription -> Bool
$c/= :: YAMLFileDescription -> YAMLFileDescription -> Bool
/= :: YAMLFileDescription -> YAMLFileDescription -> Bool
Eq, Int -> YAMLFileDescription -> ShowS
[YAMLFileDescription] -> ShowS
YAMLFileDescription -> String
(Int -> YAMLFileDescription -> ShowS)
-> (YAMLFileDescription -> String)
-> ([YAMLFileDescription] -> ShowS)
-> Show YAMLFileDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> YAMLFileDescription -> ShowS
showsPrec :: Int -> YAMLFileDescription -> ShowS
$cshow :: YAMLFileDescription -> String
show :: YAMLFileDescription -> String
$cshowList :: [YAMLFileDescription] -> ShowS
showList :: [YAMLFileDescription] -> ShowS
Show)

data YAMLServerReplicas = YAMLServerReplicas
  { YAMLServerReplicas -> XFTPServer
server :: XFTPServer,
    YAMLServerReplicas -> [String]
chunks :: [String]
  }
  deriving (YAMLServerReplicas -> YAMLServerReplicas -> Bool
(YAMLServerReplicas -> YAMLServerReplicas -> Bool)
-> (YAMLServerReplicas -> YAMLServerReplicas -> Bool)
-> Eq YAMLServerReplicas
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: YAMLServerReplicas -> YAMLServerReplicas -> Bool
== :: YAMLServerReplicas -> YAMLServerReplicas -> Bool
$c/= :: YAMLServerReplicas -> YAMLServerReplicas -> Bool
/= :: YAMLServerReplicas -> YAMLServerReplicas -> Bool
Eq, Int -> YAMLServerReplicas -> ShowS
[YAMLServerReplicas] -> ShowS
YAMLServerReplicas -> String
(Int -> YAMLServerReplicas -> ShowS)
-> (YAMLServerReplicas -> String)
-> ([YAMLServerReplicas] -> ShowS)
-> Show YAMLServerReplicas
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> YAMLServerReplicas -> ShowS
showsPrec :: Int -> YAMLServerReplicas -> ShowS
$cshow :: YAMLServerReplicas -> String
show :: YAMLServerReplicas -> String
$cshowList :: [YAMLServerReplicas] -> ShowS
showList :: [YAMLServerReplicas] -> ShowS
Show)

data FileServerReplica = FileServerReplica
  { FileServerReplica -> Int
chunkNo :: Int,
    FileServerReplica -> XFTPServer
server :: XFTPServer,
    FileServerReplica -> ChunkReplicaId
replicaId :: ChunkReplicaId,
    FileServerReplica -> APrivateAuthKey
replicaKey :: C.APrivateAuthKey,
    FileServerReplica -> Maybe FileDigest
digest :: Maybe FileDigest,
    FileServerReplica -> Maybe (FileSize Word32)
chunkSize :: Maybe (FileSize Word32)
  }
  deriving (Int -> FileServerReplica -> ShowS
[FileServerReplica] -> ShowS
FileServerReplica -> String
(Int -> FileServerReplica -> ShowS)
-> (FileServerReplica -> String)
-> ([FileServerReplica] -> ShowS)
-> Show FileServerReplica
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileServerReplica -> ShowS
showsPrec :: Int -> FileServerReplica -> ShowS
$cshow :: FileServerReplica -> String
show :: FileServerReplica -> String
$cshowList :: [FileServerReplica] -> ShowS
showList :: [FileServerReplica] -> ShowS
Show)

newtype FileSize a = FileSize {forall a. FileSize a -> a
unFileSize :: a}
  deriving (FileSize a -> FileSize a -> Bool
(FileSize a -> FileSize a -> Bool)
-> (FileSize a -> FileSize a -> Bool) -> Eq (FileSize a)
forall a. Eq a => FileSize a -> FileSize a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => FileSize a -> FileSize a -> Bool
== :: FileSize a -> FileSize a -> Bool
$c/= :: forall a. Eq a => FileSize a -> FileSize a -> Bool
/= :: FileSize a -> FileSize a -> Bool
Eq, Int -> FileSize a -> ShowS
[FileSize a] -> ShowS
FileSize a -> String
(Int -> FileSize a -> ShowS)
-> (FileSize a -> String)
-> ([FileSize a] -> ShowS)
-> Show (FileSize a)
forall a. Show a => Int -> FileSize a -> ShowS
forall a. Show a => [FileSize a] -> ShowS
forall a. Show a => FileSize a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> FileSize a -> ShowS
showsPrec :: Int -> FileSize a -> ShowS
$cshow :: forall a. Show a => FileSize a -> String
show :: FileSize a -> String
$cshowList :: forall a. Show a => [FileSize a] -> ShowS
showList :: [FileSize a] -> ShowS
Show)

instance FromJSON a => FromJSON (FileSize a) where
  parseJSON :: Value -> Parser (FileSize a)
parseJSON Value
v = a -> FileSize a
forall a. a -> FileSize a
FileSize (a -> FileSize a) -> Parser a -> Parser (FileSize a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
Y.parseJSON Value
v

instance ToJSON a => ToJSON (FileSize a) where
  toJSON :: FileSize a -> Value
toJSON = a -> Value
forall a. ToJSON a => a -> Value
Y.toJSON (a -> Value) -> (FileSize a -> a) -> FileSize a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileSize a -> a
forall a. FileSize a -> a
unFileSize

$(J.deriveJSON defaultJSON ''YAMLServerReplicas)

$(J.deriveJSON defaultJSON ''RedirectFileInfo)

$(J.deriveJSON defaultJSON ''YAMLFileDescription)

instance FilePartyI p => StrEncoding (ValidFileDescription p) where
  strEncode :: ValidFileDescription p -> ByteString
strEncode (ValidFD FileDescription p
fd) = FileDescription p -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode FileDescription p
fd
  strDecode :: ByteString -> Either String (ValidFileDescription p)
strDecode ByteString
s = ByteString -> Either String AValidFileDescription
forall a. StrEncoding a => ByteString -> Either String a
strDecode ByteString
s Either String AValidFileDescription
-> (AValidFileDescription
    -> Either String (ValidFileDescription p))
-> Either String (ValidFileDescription p)
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(AVFD ValidFileDescription p
fd) -> ValidFileDescription p -> Either String (ValidFileDescription p)
forall (t :: FileParty -> *) (p :: FileParty) (p' :: FileParty).
(FilePartyI p, FilePartyI p') =>
t p' -> Either String (t p)
checkParty ValidFileDescription p
fd)
  strP :: Parser (ValidFileDescription p)
strP = ByteString -> Either String (ValidFileDescription p)
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String (ValidFileDescription p))
-> Parser ByteString ByteString -> Parser (ValidFileDescription p)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString ByteString
A.takeByteString

instance StrEncoding AValidFileDescription where
  strEncode :: AValidFileDescription -> ByteString
strEncode (AVFD ValidFileDescription p
fd) = ValidFileDescription p -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ValidFileDescription p
fd
  strDecode :: ByteString -> Either String AValidFileDescription
strDecode = (\(AFD FileDescription p
fd) -> ValidFileDescription p -> AValidFileDescription
forall (p :: FileParty).
FilePartyI p =>
ValidFileDescription p -> AValidFileDescription
AVFD (ValidFileDescription p -> AValidFileDescription)
-> Either String (ValidFileDescription p)
-> Either String AValidFileDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileDescription p -> Either String (ValidFileDescription p)
forall (p :: FileParty).
FileDescription p -> Either String (ValidFileDescription p)
validateFileDescription FileDescription p
fd) (AFileDescription -> Either String AValidFileDescription)
-> (ByteString -> Either String AFileDescription)
-> ByteString
-> Either String AValidFileDescription
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Either String AFileDescription
forall a. StrEncoding a => ByteString -> Either String a
strDecode
  strP :: Parser AValidFileDescription
strP = ByteString -> Either String AValidFileDescription
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String AValidFileDescription)
-> Parser ByteString ByteString -> Parser AValidFileDescription
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString ByteString
A.takeByteString

instance FilePartyI p => StrEncoding (FileDescription p) where
  strEncode :: FileDescription p -> ByteString
strEncode = YAMLFileDescription -> ByteString
forall a. ToJSON a => a -> ByteString
Y.encode (YAMLFileDescription -> ByteString)
-> (FileDescription p -> YAMLFileDescription)
-> FileDescription p
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileDescription p -> YAMLFileDescription
forall (p :: FileParty). FileDescription p -> YAMLFileDescription
encodeFileDescription
  strDecode :: ByteString -> Either String (FileDescription p)
strDecode ByteString
s = ByteString -> Either String AFileDescription
forall a. StrEncoding a => ByteString -> Either String a
strDecode ByteString
s Either String AFileDescription
-> (AFileDescription -> Either String (FileDescription p))
-> Either String (FileDescription p)
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(AFD FileDescription p
fd) -> FileDescription p -> Either String (FileDescription p)
forall (t :: FileParty -> *) (p :: FileParty) (p' :: FileParty).
(FilePartyI p, FilePartyI p') =>
t p' -> Either String (t p)
checkParty FileDescription p
fd)
  strP :: Parser (FileDescription p)
strP = ByteString -> Either String (FileDescription p)
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String (FileDescription p))
-> Parser ByteString ByteString -> Parser (FileDescription p)
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString ByteString
A.takeByteString

instance StrEncoding AFileDescription where
  strEncode :: AFileDescription -> ByteString
strEncode (AFD FileDescription p
fd) = FileDescription p -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode FileDescription p
fd
  strDecode :: ByteString -> Either String AFileDescription
strDecode = YAMLFileDescription -> Either String AFileDescription
decodeFileDescription (YAMLFileDescription -> Either String AFileDescription)
-> (ByteString -> Either String YAMLFileDescription)
-> ByteString
-> Either String AFileDescription
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (ParseException -> String)
-> Either ParseException YAMLFileDescription
-> Either String YAMLFileDescription
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseException -> String
forall a. Show a => a -> String
show (Either ParseException YAMLFileDescription
 -> Either String YAMLFileDescription)
-> (ByteString -> Either ParseException YAMLFileDescription)
-> ByteString
-> Either String YAMLFileDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ParseException YAMLFileDescription
forall a. FromJSON a => ByteString -> Either ParseException a
Y.decodeEither'
  strP :: Parser AFileDescription
strP = ByteString -> Either String AFileDescription
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String AFileDescription)
-> Parser ByteString ByteString -> Parser AFileDescription
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString ByteString
A.takeByteString

validateFileDescription :: FileDescription p -> Either String (ValidFileDescription p)
validateFileDescription :: forall (p :: FileParty).
FileDescription p -> Either String (ValidFileDescription p)
validateFileDescription fd :: FileDescription p
fd@FileDescription {FileSize Int64
$sel:size:FileDescription :: forall (p :: FileParty). FileDescription p -> FileSize Int64
size :: FileSize Int64
size, [FileChunk]
$sel:chunks:FileDescription :: forall (p :: FileParty). FileDescription p -> [FileChunk]
chunks :: [FileChunk]
chunks}
  | [Int]
chunkNos [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int
1 .. [FileChunk] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FileChunk]
chunks] = String -> Either String (ValidFileDescription p)
forall a b. a -> Either a b
Left String
"chunk numbers are not sequential"
  | [FileChunk] -> Int64
chunksSize [FileChunk]
chunks Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= FileSize Int64 -> Int64
forall a. FileSize a -> a
unFileSize FileSize Int64
size = String -> Either String (ValidFileDescription p)
forall a b. a -> Either a b
Left String
"chunks total size is different than file size"
  | Bool
otherwise = ValidFileDescription p -> Either String (ValidFileDescription p)
forall a b. b -> Either a b
Right (ValidFileDescription p -> Either String (ValidFileDescription p))
-> ValidFileDescription p -> Either String (ValidFileDescription p)
forall a b. (a -> b) -> a -> b
$ FileDescription p -> ValidFileDescription p
forall (p :: FileParty).
FileDescription p -> ValidFileDescription p
ValidFD FileDescription p
fd
  where
    chunkNos :: [Int]
chunkNos = (FileChunk -> Int) -> [FileChunk] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\FileChunk {Int
$sel:chunkNo:FileChunk :: FileChunk -> Int
chunkNo :: Int
chunkNo} -> Int
chunkNo) [FileChunk]
chunks
    chunksSize :: [FileChunk] -> Int64
chunksSize = (Int64 -> FileChunk -> Int64) -> Int64 -> [FileChunk] -> Int64
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(Int64
s :: Int64) FileChunk {FileSize Word32
$sel:chunkSize:FileChunk :: FileChunk -> FileSize Word32
chunkSize :: FileSize Word32
chunkSize} -> Int64
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileSize Word32 -> Word32
forall a. FileSize a -> a
unFileSize FileSize Word32
chunkSize)) Int64
0

encodeFileDescription :: FileDescription p -> YAMLFileDescription
encodeFileDescription :: forall (p :: FileParty). FileDescription p -> YAMLFileDescription
encodeFileDescription FileDescription {SFileParty p
$sel:party:FileDescription :: forall (p :: FileParty). FileDescription p -> SFileParty p
party :: SFileParty p
party, FileSize Int64
$sel:size:FileDescription :: forall (p :: FileParty). FileDescription p -> FileSize Int64
size :: FileSize Int64
size, FileDigest
$sel:digest:FileDescription :: forall (p :: FileParty). FileDescription p -> FileDigest
digest :: FileDigest
digest, SbKey
$sel:key:FileDescription :: forall (p :: FileParty). FileDescription p -> SbKey
key :: SbKey
key, CbNonce
$sel:nonce:FileDescription :: forall (p :: FileParty). FileDescription p -> CbNonce
nonce :: CbNonce
nonce, FileSize Word32
$sel:chunkSize:FileDescription :: forall (p :: FileParty). FileDescription p -> FileSize Word32
chunkSize :: FileSize Word32
chunkSize, [FileChunk]
$sel:chunks:FileDescription :: forall (p :: FileParty). FileDescription p -> [FileChunk]
chunks :: [FileChunk]
chunks, Maybe RedirectFileInfo
$sel:redirect:FileDescription :: forall (p :: FileParty).
FileDescription p -> Maybe RedirectFileInfo
redirect :: Maybe RedirectFileInfo
redirect} =
  YAMLFileDescription
    { $sel:party:YAMLFileDescription :: FileParty
party = SFileParty p -> FileParty
forall (p :: FileParty). SFileParty p -> FileParty
toFileParty SFileParty p
party,
      $sel:size:YAMLFileDescription :: String
size = ByteString -> String
B.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ FileSize Int64 -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode FileSize Int64
size,
      FileDigest
$sel:digest:YAMLFileDescription :: FileDigest
digest :: FileDigest
digest,
      SbKey
$sel:key:YAMLFileDescription :: SbKey
key :: SbKey
key,
      CbNonce
$sel:nonce:YAMLFileDescription :: CbNonce
nonce :: CbNonce
nonce,
      $sel:chunkSize:YAMLFileDescription :: String
chunkSize = ByteString -> String
B.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ FileSize Word32 -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode FileSize Word32
chunkSize,
      $sel:replicas:YAMLFileDescription :: [YAMLServerReplicas]
replicas = FileSize Word32 -> [FileChunk] -> [YAMLServerReplicas]
encodeFileReplicas FileSize Word32
chunkSize [FileChunk]
chunks,
      Maybe RedirectFileInfo
$sel:redirect:YAMLFileDescription :: Maybe RedirectFileInfo
redirect :: Maybe RedirectFileInfo
redirect
    }

data FileDescriptionURI = FileDescriptionURI
  { FileDescriptionURI -> ServiceScheme
scheme :: ServiceScheme,
    FileDescriptionURI -> ValidFileDescription 'FRecipient
description :: ValidFileDescription 'FRecipient,
    FileDescriptionURI -> Maybe FileClientData
clientData :: Maybe FileClientData -- JSON-encoded extensions to pass in a link
  }
  deriving (FileDescriptionURI -> FileDescriptionURI -> Bool
(FileDescriptionURI -> FileDescriptionURI -> Bool)
-> (FileDescriptionURI -> FileDescriptionURI -> Bool)
-> Eq FileDescriptionURI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileDescriptionURI -> FileDescriptionURI -> Bool
== :: FileDescriptionURI -> FileDescriptionURI -> Bool
$c/= :: FileDescriptionURI -> FileDescriptionURI -> Bool
/= :: FileDescriptionURI -> FileDescriptionURI -> Bool
Eq, Int -> FileDescriptionURI -> ShowS
[FileDescriptionURI] -> ShowS
FileDescriptionURI -> String
(Int -> FileDescriptionURI -> ShowS)
-> (FileDescriptionURI -> String)
-> ([FileDescriptionURI] -> ShowS)
-> Show FileDescriptionURI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileDescriptionURI -> ShowS
showsPrec :: Int -> FileDescriptionURI -> ShowS
$cshow :: FileDescriptionURI -> String
show :: FileDescriptionURI -> String
$cshowList :: [FileDescriptionURI] -> ShowS
showList :: [FileDescriptionURI] -> ShowS
Show)

type FileClientData = Text

fileDescriptionURI :: ValidFileDescription 'FRecipient -> FileDescriptionURI
fileDescriptionURI :: ValidFileDescription 'FRecipient -> FileDescriptionURI
fileDescriptionURI ValidFileDescription 'FRecipient
vfd = ServiceScheme
-> ValidFileDescription 'FRecipient
-> Maybe FileClientData
-> FileDescriptionURI
FileDescriptionURI ServiceScheme
SSSimplex ValidFileDescription 'FRecipient
vfd Maybe FileClientData
forall a. Monoid a => a
mempty

instance StrEncoding FileDescriptionURI where
  strEncode :: FileDescriptionURI -> ByteString
strEncode FileDescriptionURI {ServiceScheme
$sel:scheme:FileDescriptionURI :: FileDescriptionURI -> ServiceScheme
scheme :: ServiceScheme
scheme, ValidFileDescription 'FRecipient
$sel:description:FileDescriptionURI :: FileDescriptionURI -> ValidFileDescription 'FRecipient
description :: ValidFileDescription 'FRecipient
description, Maybe FileClientData
$sel:clientData:FileDescriptionURI :: FileDescriptionURI -> Maybe FileClientData
clientData :: Maybe FileClientData
clientData} = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat [ServiceScheme -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ServiceScheme
scheme, ByteString
"/file", ByteString
"#/?", ByteString
queryStr]
    where
      queryStr :: ByteString
queryStr = QueryStringParams -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (QueryStringParams -> ByteString)
-> QueryStringParams -> ByteString
forall a b. (a -> b) -> a -> b
$ QSPEscaping -> SimpleQuery -> QueryStringParams
QSP QSPEscaping
QEscape SimpleQuery
qs
      qs :: SimpleQuery
qs = (ByteString
"desc", ValidFileDescription 'FRecipient -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ValidFileDescription 'FRecipient
description) (ByteString, ByteString) -> SimpleQuery -> SimpleQuery
forall a. a -> [a] -> [a]
: SimpleQuery
-> (FileClientData -> SimpleQuery)
-> Maybe FileClientData
-> SimpleQuery
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\FileClientData
cd -> [(ByteString
"data", FileClientData -> ByteString
encodeUtf8 FileClientData
cd)]) Maybe FileClientData
clientData
  strP :: Parser FileDescriptionURI
strP = do
    ServiceScheme
scheme <- Parser ServiceScheme
forall a. StrEncoding a => Parser a
strP
    ByteString
_ <- Parser ByteString ByteString
"/file" Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char -> Parser ByteString (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser ByteString Char
A.char Char
'/') Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
"#/?"
    QueryStringParams
query <- Parser QueryStringParams
forall a. StrEncoding a => Parser a
strP
    ValidFileDescription 'FRecipient
description <- ByteString
-> QueryStringParams -> Parser (ValidFileDescription 'FRecipient)
forall a.
StrEncoding a =>
ByteString -> QueryStringParams -> Parser a
queryParam ByteString
"desc" QueryStringParams
query
    let clientData :: Maybe FileClientData
clientData = ByteString -> FileClientData
safeDecodeUtf8 (ByteString -> FileClientData)
-> Maybe ByteString -> Maybe FileClientData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> QueryStringParams -> Maybe ByteString
queryParamStr ByteString
"data" QueryStringParams
query
    FileDescriptionURI -> Parser FileDescriptionURI
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileDescriptionURI {ServiceScheme
$sel:scheme:FileDescriptionURI :: ServiceScheme
scheme :: ServiceScheme
scheme, ValidFileDescription 'FRecipient
$sel:description:FileDescriptionURI :: ValidFileDescription 'FRecipient
description :: ValidFileDescription 'FRecipient
description, Maybe FileClientData
$sel:clientData:FileDescriptionURI :: Maybe FileClientData
clientData :: Maybe FileClientData
clientData}

-- | URL length in QR code before jumping up to a next size.
qrSizeLimit :: Int
qrSizeLimit :: Int
qrSizeLimit = Int
1002 -- ~2 chunks in URLencoded YAML with some spare size for server hosts

-- | Soft limit for XFTP clients. Should be checked and reported to user.
maxFileSize :: Int64
maxFileSize :: Int64
maxFileSize = Int64 -> Int64
forall a. Integral a => a -> a
gb Int64
1

maxFileSizeStr :: String
maxFileSizeStr :: String
maxFileSizeStr = ByteString -> String
B.unpack (ByteString -> String)
-> (FileSize Int64 -> ByteString) -> FileSize Int64 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileSize Int64 -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (FileSize Int64 -> String) -> FileSize Int64 -> String
forall a b. (a -> b) -> a -> b
$ Int64 -> FileSize Int64
forall a. a -> FileSize a
FileSize Int64
maxFileSize

-- | Hard internal limit for XFTP agent after which it refuses to prepare chunks.
maxFileSizeHard :: Int64
maxFileSizeHard :: Int64
maxFileSizeHard = Int64 -> Int64
forall a. Integral a => a -> a
gb Int64
5

fileSizeLen :: Int64
fileSizeLen :: Int64
fileSizeLen = Int64
8


instance (Integral a, Show a) => StrEncoding (FileSize a) where
  strEncode :: FileSize a -> ByteString
strEncode (FileSize a
b)
    | a
b' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 = a -> ByteString
forall a. Show a => a -> ByteString
bshow a
b
    | a
ks' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 = a -> ByteString
forall a. Show a => a -> ByteString
bshow a
ks ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"kb"
    | a
ms' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 = a -> ByteString
forall a. Show a => a -> ByteString
bshow a
ms ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"mb"
    | Bool
otherwise = a -> ByteString
forall a. Show a => a -> ByteString
bshow a
gs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"gb"
    where
      (a
ks, a
b') = a
b a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`divMod` a
1024
      (a
ms, a
ks') = a
ks a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`divMod` a
1024
      (a
gs, a
ms') = a
ms a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`divMod` a
1024
  strP :: Parser (FileSize a)
strP =
    a -> FileSize a
forall a. a -> FileSize a
FileSize
      (a -> FileSize a) -> Parser ByteString a -> Parser (FileSize a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser ByteString a] -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice
        [ a -> a
forall a. Integral a => a -> a
gb (a -> a) -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString a
forall a. Integral a => Parser a
A.decimal Parser ByteString a
-> Parser ByteString ByteString -> Parser ByteString a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
"gb",
          a -> a
forall a. Integral a => a -> a
mb (a -> a) -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString a
forall a. Integral a => Parser a
A.decimal Parser ByteString a
-> Parser ByteString ByteString -> Parser ByteString a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
"mb",
          a -> a
forall a. Integral a => a -> a
kb (a -> a) -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString a
forall a. Integral a => Parser a
A.decimal Parser ByteString a
-> Parser ByteString ByteString -> Parser ByteString a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
"kb",
          Parser ByteString a
forall a. Integral a => Parser a
A.decimal
        ]

instance (Integral a, Show a) => IsString (FileSize a) where
  fromString :: String -> FileSize a
fromString = (String -> FileSize a)
-> (FileSize a -> FileSize a)
-> Either String (FileSize a)
-> FileSize a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> FileSize a
forall a. HasCallStack => String -> a
error FileSize a -> FileSize a
forall a. a -> a
id (Either String (FileSize a) -> FileSize a)
-> (String -> Either String (FileSize a)) -> String -> FileSize a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (FileSize a)
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String (FileSize a))
-> (String -> ByteString) -> String -> Either String (FileSize a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B.pack

deriving newtype instance FromField a => FromField (FileSize a)

deriving newtype instance ToField a => ToField (FileSize a)

groupReplicasByServer :: FileSize Word32 -> [FileChunk] -> [NonEmpty FileServerReplica]
groupReplicasByServer :: FileSize Word32 -> [FileChunk] -> [NonEmpty FileServerReplica]
groupReplicasByServer FileSize Word32
defChunkSize =
  (FileServerReplica -> XFTPServer)
-> [FileServerReplica] -> [NonEmpty FileServerReplica]
forall b a. Ord b => (a -> b) -> [a] -> [NonEmpty a]
L.groupAllWith (\FileServerReplica {XFTPServer
$sel:server:FileServerReplica :: FileServerReplica -> XFTPServer
server :: XFTPServer
server} -> XFTPServer
server) ([FileServerReplica] -> [NonEmpty FileServerReplica])
-> ([FileChunk] -> [FileServerReplica])
-> [FileChunk]
-> [NonEmpty FileServerReplica]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileSize Word32 -> [FileChunk] -> [FileServerReplica]
unfoldChunksToReplicas FileSize Word32
defChunkSize

encodeFileReplicas :: FileSize Word32 -> [FileChunk] -> [YAMLServerReplicas]
encodeFileReplicas :: FileSize Word32 -> [FileChunk] -> [YAMLServerReplicas]
encodeFileReplicas FileSize Word32
defChunkSize =
  (NonEmpty FileServerReplica -> YAMLServerReplicas)
-> [NonEmpty FileServerReplica] -> [YAMLServerReplicas]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty FileServerReplica -> YAMLServerReplicas
encodeServerReplicas ([NonEmpty FileServerReplica] -> [YAMLServerReplicas])
-> ([FileChunk] -> [NonEmpty FileServerReplica])
-> [FileChunk]
-> [YAMLServerReplicas]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileSize Word32 -> [FileChunk] -> [NonEmpty FileServerReplica]
groupReplicasByServer FileSize Word32
defChunkSize
  where
    encodeServerReplicas :: NonEmpty FileServerReplica -> YAMLServerReplicas
encodeServerReplicas fs :: NonEmpty FileServerReplica
fs@(FileServerReplica {XFTPServer
$sel:server:FileServerReplica :: FileServerReplica -> XFTPServer
server :: XFTPServer
server} :| [FileServerReplica]
_) =
      YAMLServerReplicas
        { XFTPServer
$sel:server:YAMLServerReplicas :: XFTPServer
server :: XFTPServer
server,
          $sel:chunks:YAMLServerReplicas :: [String]
chunks = (FileServerReplica -> String) -> [FileServerReplica] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> String
B.unpack (ByteString -> String)
-> (FileServerReplica -> ByteString) -> FileServerReplica -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileServerReplica -> ByteString
encodeServerReplica) ([FileServerReplica] -> [String])
-> [FileServerReplica] -> [String]
forall a b. (a -> b) -> a -> b
$ NonEmpty FileServerReplica -> [FileServerReplica]
forall a. NonEmpty a -> [a]
L.toList NonEmpty FileServerReplica
fs
        }

encodeServerReplica :: FileServerReplica -> ByteString
encodeServerReplica :: FileServerReplica -> ByteString
encodeServerReplica FileServerReplica {Int
$sel:chunkNo:FileServerReplica :: FileServerReplica -> Int
chunkNo :: Int
chunkNo, ChunkReplicaId
$sel:replicaId:FileServerReplica :: FileServerReplica -> ChunkReplicaId
replicaId :: ChunkReplicaId
replicaId, APrivateAuthKey
$sel:replicaKey:FileServerReplica :: FileServerReplica -> APrivateAuthKey
replicaKey :: APrivateAuthKey
replicaKey, Maybe FileDigest
$sel:digest:FileServerReplica :: FileServerReplica -> Maybe FileDigest
digest :: Maybe FileDigest
digest, Maybe (FileSize Word32)
$sel:chunkSize:FileServerReplica :: FileServerReplica -> Maybe (FileSize Word32)
chunkSize :: Maybe (FileSize Word32)
chunkSize} =
  Int -> ByteString
forall a. Show a => a -> ByteString
bshow Int
chunkNo
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
":"
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ChunkReplicaId -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ChunkReplicaId
replicaId
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
":"
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> APrivateAuthKey -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode APrivateAuthKey
replicaKey
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
-> (FileDigest -> ByteString) -> Maybe FileDigest -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" ((ByteString
":" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> (FileDigest -> ByteString) -> FileDigest -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileDigest -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode) Maybe FileDigest
digest
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
-> (FileSize Word32 -> ByteString)
-> Maybe (FileSize Word32)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" ((ByteString
":" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> (FileSize Word32 -> ByteString) -> FileSize Word32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileSize Word32 -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode) Maybe (FileSize Word32)
chunkSize

serverReplicaP :: XFTPServer -> Parser FileServerReplica
serverReplicaP :: XFTPServer -> Parser FileServerReplica
serverReplicaP XFTPServer
server = do
  Int
chunkNo <- Parser Int
forall a. Integral a => Parser a
A.decimal
  ChunkReplicaId
replicaId <- Char -> Parser ByteString Char
A.char Char
':' Parser ByteString Char
-> Parser ChunkReplicaId -> Parser ChunkReplicaId
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ChunkReplicaId
forall a. StrEncoding a => Parser a
strP
  APrivateAuthKey
replicaKey <- Char -> Parser ByteString Char
A.char Char
':' Parser ByteString Char
-> Parser ByteString APrivateAuthKey
-> Parser ByteString APrivateAuthKey
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString APrivateAuthKey
forall a. StrEncoding a => Parser a
strP
  Maybe FileDigest
digest <- Parser FileDigest -> Parser ByteString (Maybe FileDigest)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser ByteString Char
A.char Char
':' Parser ByteString Char -> Parser FileDigest -> Parser FileDigest
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser FileDigest
forall a. StrEncoding a => Parser a
strP)
  Maybe (FileSize Word32)
chunkSize <- Parser ByteString (FileSize Word32)
-> Parser ByteString (Maybe (FileSize Word32))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser ByteString Char
A.char Char
':' Parser ByteString Char
-> Parser ByteString (FileSize Word32)
-> Parser ByteString (FileSize Word32)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (FileSize Word32)
forall a. StrEncoding a => Parser a
strP)
  FileServerReplica -> Parser FileServerReplica
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileServerReplica {Int
$sel:chunkNo:FileServerReplica :: Int
chunkNo :: Int
chunkNo, XFTPServer
$sel:server:FileServerReplica :: XFTPServer
server :: XFTPServer
server, ChunkReplicaId
$sel:replicaId:FileServerReplica :: ChunkReplicaId
replicaId :: ChunkReplicaId
replicaId, APrivateAuthKey
$sel:replicaKey:FileServerReplica :: APrivateAuthKey
replicaKey :: APrivateAuthKey
replicaKey, Maybe FileDigest
$sel:digest:FileServerReplica :: Maybe FileDigest
digest :: Maybe FileDigest
digest, Maybe (FileSize Word32)
$sel:chunkSize:FileServerReplica :: Maybe (FileSize Word32)
chunkSize :: Maybe (FileSize Word32)
chunkSize}

unfoldChunksToReplicas :: FileSize Word32 -> [FileChunk] -> [FileServerReplica]
unfoldChunksToReplicas :: FileSize Word32 -> [FileChunk] -> [FileServerReplica]
unfoldChunksToReplicas FileSize Word32
defChunkSize = (FileChunk -> [FileServerReplica])
-> [FileChunk] -> [FileServerReplica]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FileChunk -> [FileServerReplica]
chunkReplicas
  where
    chunkReplicas :: FileChunk -> [FileServerReplica]
chunkReplicas c :: FileChunk
c@FileChunk {[FileChunkReplica]
$sel:replicas:FileChunk :: FileChunk -> [FileChunkReplica]
replicas :: [FileChunkReplica]
replicas} = (Int -> FileChunkReplica -> FileServerReplica)
-> [Int] -> [FileChunkReplica] -> [FileServerReplica]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (FileChunk -> Int -> FileChunkReplica -> FileServerReplica
replicaToServerReplica FileChunk
c) [Int
1 ..] [FileChunkReplica]
replicas
    replicaToServerReplica :: FileChunk -> Int -> FileChunkReplica -> FileServerReplica
    replicaToServerReplica :: FileChunk -> Int -> FileChunkReplica -> FileServerReplica
replicaToServerReplica FileChunk {Int
$sel:chunkNo:FileChunk :: FileChunk -> Int
chunkNo :: Int
chunkNo, FileDigest
$sel:digest:FileChunk :: FileChunk -> FileDigest
digest :: FileDigest
digest, FileSize Word32
$sel:chunkSize:FileChunk :: FileChunk -> FileSize Word32
chunkSize :: FileSize Word32
chunkSize} Int
replicaNo FileChunkReplica {XFTPServer
$sel:server:FileChunkReplica :: FileChunkReplica -> XFTPServer
server :: XFTPServer
server, ChunkReplicaId
$sel:replicaId:FileChunkReplica :: FileChunkReplica -> ChunkReplicaId
replicaId :: ChunkReplicaId
replicaId, APrivateAuthKey
$sel:replicaKey:FileChunkReplica :: FileChunkReplica -> APrivateAuthKey
replicaKey :: APrivateAuthKey
replicaKey} =
      let chunkSize' :: Maybe (FileSize Word32)
chunkSize' = if FileSize Word32
chunkSize FileSize Word32 -> FileSize Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= FileSize Word32
defChunkSize Bool -> Bool -> Bool
&& Int
replicaNo Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then FileSize Word32 -> Maybe (FileSize Word32)
forall a. a -> Maybe a
Just FileSize Word32
chunkSize else Maybe (FileSize Word32)
forall a. Maybe a
Nothing
          digest' :: Maybe FileDigest
digest' = if Int
replicaNo Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then FileDigest -> Maybe FileDigest
forall a. a -> Maybe a
Just FileDigest
digest else Maybe FileDigest
forall a. Maybe a
Nothing
       in FileServerReplica {Int
$sel:chunkNo:FileServerReplica :: Int
chunkNo :: Int
chunkNo, XFTPServer
$sel:server:FileServerReplica :: XFTPServer
server :: XFTPServer
server, ChunkReplicaId
$sel:replicaId:FileServerReplica :: ChunkReplicaId
replicaId :: ChunkReplicaId
replicaId, APrivateAuthKey
$sel:replicaKey:FileServerReplica :: APrivateAuthKey
replicaKey :: APrivateAuthKey
replicaKey, $sel:digest:FileServerReplica :: Maybe FileDigest
digest = Maybe FileDigest
digest', $sel:chunkSize:FileServerReplica :: Maybe (FileSize Word32)
chunkSize = Maybe (FileSize Word32)
chunkSize'}

decodeFileDescription :: YAMLFileDescription -> Either String AFileDescription
decodeFileDescription :: YAMLFileDescription -> Either String AFileDescription
decodeFileDescription YAMLFileDescription {FileParty
$sel:party:YAMLFileDescription :: YAMLFileDescription -> FileParty
party :: FileParty
party, String
$sel:size:YAMLFileDescription :: YAMLFileDescription -> String
size :: String
size, FileDigest
$sel:digest:YAMLFileDescription :: YAMLFileDescription -> FileDigest
digest :: FileDigest
digest, SbKey
$sel:key:YAMLFileDescription :: YAMLFileDescription -> SbKey
key :: SbKey
key, CbNonce
$sel:nonce:YAMLFileDescription :: YAMLFileDescription -> CbNonce
nonce :: CbNonce
nonce, String
$sel:chunkSize:YAMLFileDescription :: YAMLFileDescription -> String
chunkSize :: String
chunkSize, [YAMLServerReplicas]
$sel:replicas:YAMLFileDescription :: YAMLFileDescription -> [YAMLServerReplicas]
replicas :: [YAMLServerReplicas]
replicas, Maybe RedirectFileInfo
$sel:redirect:YAMLFileDescription :: YAMLFileDescription -> Maybe RedirectFileInfo
redirect :: Maybe RedirectFileInfo
redirect} = do
  FileSize Int64
size' <- ByteString -> Either String (FileSize Int64)
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String (FileSize Int64))
-> ByteString -> Either String (FileSize Int64)
forall a b. (a -> b) -> a -> b
$ String -> ByteString
B.pack String
size
  FileSize Word32
chunkSize' <- ByteString -> Either String (FileSize Word32)
forall a. StrEncoding a => ByteString -> Either String a
strDecode (ByteString -> Either String (FileSize Word32))
-> ByteString -> Either String (FileSize Word32)
forall a b. (a -> b) -> a -> b
$ String -> ByteString
B.pack String
chunkSize
  [FileServerReplica]
replicas' <- [YAMLServerReplicas] -> Either String [FileServerReplica]
decodeFileParts [YAMLServerReplicas]
replicas
  [FileChunk]
chunks <- FileSize Word32 -> [FileServerReplica] -> Either String [FileChunk]
foldReplicasToChunks FileSize Word32
chunkSize' [FileServerReplica]
replicas'
  AFileDescription -> Either String AFileDescription
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AFileDescription -> Either String AFileDescription)
-> AFileDescription -> Either String AFileDescription
forall a b. (a -> b) -> a -> b
$ case FileParty -> AFileParty
aFileParty FileParty
party of
    AFP SFileParty p
party' -> FileDescription p -> AFileDescription
forall (p :: FileParty).
FilePartyI p =>
FileDescription p -> AFileDescription
AFD FileDescription {$sel:party:FileDescription :: SFileParty p
party = SFileParty p
party', $sel:size:FileDescription :: FileSize Int64
size = FileSize Int64
size', FileDigest
$sel:digest:FileDescription :: FileDigest
digest :: FileDigest
digest, SbKey
$sel:key:FileDescription :: SbKey
key :: SbKey
key, CbNonce
$sel:nonce:FileDescription :: CbNonce
nonce :: CbNonce
nonce, $sel:chunkSize:FileDescription :: FileSize Word32
chunkSize = FileSize Word32
chunkSize', [FileChunk]
$sel:chunks:FileDescription :: [FileChunk]
chunks :: [FileChunk]
chunks, Maybe RedirectFileInfo
$sel:redirect:FileDescription :: Maybe RedirectFileInfo
redirect :: Maybe RedirectFileInfo
redirect}
  where
    decodeFileParts :: [YAMLServerReplicas] -> Either String [FileServerReplica]
decodeFileParts = ([[FileServerReplica]] -> [FileServerReplica])
-> Either String [[FileServerReplica]]
-> Either String [FileServerReplica]
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FileServerReplica]] -> [FileServerReplica]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Either String [[FileServerReplica]]
 -> Either String [FileServerReplica])
-> ([YAMLServerReplicas] -> Either String [[FileServerReplica]])
-> [YAMLServerReplicas]
-> Either String [FileServerReplica]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (YAMLServerReplicas -> Either String [FileServerReplica])
-> [YAMLServerReplicas] -> Either String [[FileServerReplica]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM YAMLServerReplicas -> Either String [FileServerReplica]
decodeYAMLServerReplicas

decodeYAMLServerReplicas :: YAMLServerReplicas -> Either String [FileServerReplica]
decodeYAMLServerReplicas :: YAMLServerReplicas -> Either String [FileServerReplica]
decodeYAMLServerReplicas YAMLServerReplicas {XFTPServer
$sel:server:YAMLServerReplicas :: YAMLServerReplicas -> XFTPServer
server :: XFTPServer
server, [String]
$sel:chunks:YAMLServerReplicas :: YAMLServerReplicas -> [String]
chunks :: [String]
chunks} =
  (String -> Either String FileServerReplica)
-> [String] -> Either String [FileServerReplica]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Parser FileServerReplica
-> ByteString -> Either String FileServerReplica
forall a. Parser a -> ByteString -> Either String a
parseAll (XFTPServer -> Parser FileServerReplica
serverReplicaP XFTPServer
server) (ByteString -> Either String FileServerReplica)
-> (String -> ByteString)
-> String
-> Either String FileServerReplica
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B.pack) [String]
chunks

-- this function should fail if:
-- 1. no replica has digest or two replicas have different digests
-- 2. two replicas have different chunk sizes
foldReplicasToChunks :: FileSize Word32 -> [FileServerReplica] -> Either String [FileChunk]
foldReplicasToChunks :: FileSize Word32 -> [FileServerReplica] -> Either String [FileChunk]
foldReplicasToChunks FileSize Word32
defChunkSize [FileServerReplica]
fs = do
  (Map Int (FileSize Word32), Map Int FileDigest)
sd <- [FileServerReplica]
-> Either String (Map Int (FileSize Word32), Map Int FileDigest)
foldSizesDigests [FileServerReplica]
fs
  -- TODO validate (check that chunks match) or in separate function
  (FileChunk -> Int) -> [FileChunk] -> [FileChunk]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\FileChunk {Int
$sel:chunkNo:FileChunk :: FileChunk -> Int
chunkNo :: Int
chunkNo} -> Int
chunkNo) ([FileChunk] -> [FileChunk])
-> (Map Int FileChunk -> [FileChunk])
-> Map Int FileChunk
-> [FileChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileChunk -> FileChunk) -> [FileChunk] -> [FileChunk]
forall a b. (a -> b) -> [a] -> [b]
map FileChunk -> FileChunk
reverseReplicas ([FileChunk] -> [FileChunk])
-> (Map Int FileChunk -> [FileChunk])
-> Map Int FileChunk
-> [FileChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int FileChunk -> [FileChunk]
forall k a. Map k a -> [a]
M.elems (Map Int FileChunk -> [FileChunk])
-> Either String (Map Int FileChunk) -> Either String [FileChunk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map Int (FileSize Word32), Map Int FileDigest)
-> [FileServerReplica] -> Either String (Map Int FileChunk)
foldChunks (Map Int (FileSize Word32), Map Int FileDigest)
sd [FileServerReplica]
fs
  where
    foldSizesDigests :: [FileServerReplica] -> Either String (Map Int (FileSize Word32), Map Int FileDigest)
    foldSizesDigests :: [FileServerReplica]
-> Either String (Map Int (FileSize Word32), Map Int FileDigest)
foldSizesDigests = (Either String (Map Int (FileSize Word32), Map Int FileDigest)
 -> FileServerReplica
 -> Either String (Map Int (FileSize Word32), Map Int FileDigest))
-> Either String (Map Int (FileSize Word32), Map Int FileDigest)
-> [FileServerReplica]
-> Either String (Map Int (FileSize Word32), Map Int FileDigest)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Either String (Map Int (FileSize Word32), Map Int FileDigest)
-> FileServerReplica
-> Either String (Map Int (FileSize Word32), Map Int FileDigest)
addSizeDigest (Either String (Map Int (FileSize Word32), Map Int FileDigest)
 -> [FileServerReplica]
 -> Either String (Map Int (FileSize Word32), Map Int FileDigest))
-> Either String (Map Int (FileSize Word32), Map Int FileDigest)
-> [FileServerReplica]
-> Either String (Map Int (FileSize Word32), Map Int FileDigest)
forall a b. (a -> b) -> a -> b
$ (Map Int (FileSize Word32), Map Int FileDigest)
-> Either String (Map Int (FileSize Word32), Map Int FileDigest)
forall a b. b -> Either a b
Right (Map Int (FileSize Word32)
forall k a. Map k a
M.empty, Map Int FileDigest
forall k a. Map k a
M.empty)
    addSizeDigest :: Either String (Map Int (FileSize Word32), Map Int FileDigest) -> FileServerReplica -> Either String (Map Int (FileSize Word32), Map Int FileDigest)
    addSizeDigest :: Either String (Map Int (FileSize Word32), Map Int FileDigest)
-> FileServerReplica
-> Either String (Map Int (FileSize Word32), Map Int FileDigest)
addSizeDigest (Left String
e) FileServerReplica
_ = String
-> Either String (Map Int (FileSize Word32), Map Int FileDigest)
forall a b. a -> Either a b
Left String
e
    addSizeDigest (Right (Map Int (FileSize Word32)
ms, Map Int FileDigest
md)) FileServerReplica {Int
$sel:chunkNo:FileServerReplica :: FileServerReplica -> Int
chunkNo :: Int
chunkNo, Maybe (FileSize Word32)
$sel:chunkSize:FileServerReplica :: FileServerReplica -> Maybe (FileSize Word32)
chunkSize :: Maybe (FileSize Word32)
chunkSize, Maybe FileDigest
$sel:digest:FileServerReplica :: FileServerReplica -> Maybe FileDigest
digest :: Maybe FileDigest
digest} =
      (,) (Map Int (FileSize Word32)
 -> Map Int FileDigest
 -> (Map Int (FileSize Word32), Map Int FileDigest))
-> Either String (Map Int (FileSize Word32))
-> Either
     String
     (Map Int FileDigest
      -> (Map Int (FileSize Word32), Map Int FileDigest))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Int (FileSize Word32)
-> Int
-> Maybe (FileSize Word32)
-> Either String (Map Int (FileSize Word32))
forall a.
Eq a =>
Map Int a -> Int -> Maybe a -> Either String (Map Int a)
combineChunk Map Int (FileSize Word32)
ms Int
chunkNo Maybe (FileSize Word32)
chunkSize Either
  String
  (Map Int FileDigest
   -> (Map Int (FileSize Word32), Map Int FileDigest))
-> Either String (Map Int FileDigest)
-> Either String (Map Int (FileSize Word32), Map Int FileDigest)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map Int FileDigest
-> Int -> Maybe FileDigest -> Either String (Map Int FileDigest)
forall a.
Eq a =>
Map Int a -> Int -> Maybe a -> Either String (Map Int a)
combineChunk Map Int FileDigest
md Int
chunkNo Maybe FileDigest
digest
    combineChunk :: Eq a => Map Int a -> Int -> Maybe a -> Either String (Map Int a)
    combineChunk :: forall a.
Eq a =>
Map Int a -> Int -> Maybe a -> Either String (Map Int a)
combineChunk Map Int a
m Int
_ Maybe a
Nothing = Map Int a -> Either String (Map Int a)
forall a b. b -> Either a b
Right Map Int a
m
    combineChunk Map Int a
m Int
chunkNo (Just a
value) = case Int -> Map Int a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
chunkNo Map Int a
m of
      Maybe a
Nothing -> Map Int a -> Either String (Map Int a)
forall a b. b -> Either a b
Right (Map Int a -> Either String (Map Int a))
-> Map Int a -> Either String (Map Int a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> Map Int a -> Map Int a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
chunkNo a
value Map Int a
m
      Just a
v -> if a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
value then Map Int a -> Either String (Map Int a)
forall a b. b -> Either a b
Right Map Int a
m else String -> Either String (Map Int a)
forall a b. a -> Either a b
Left String
"different size or digest in chunk replicas"
    foldChunks :: (Map Int (FileSize Word32), Map Int FileDigest) -> [FileServerReplica] -> Either String (Map Int FileChunk)
    foldChunks :: (Map Int (FileSize Word32), Map Int FileDigest)
-> [FileServerReplica] -> Either String (Map Int FileChunk)
foldChunks (Map Int (FileSize Word32), Map Int FileDigest)
sd = (Either String (Map Int FileChunk)
 -> FileServerReplica -> Either String (Map Int FileChunk))
-> Either String (Map Int FileChunk)
-> [FileServerReplica]
-> Either String (Map Int FileChunk)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Map Int (FileSize Word32), Map Int FileDigest)
-> Either String (Map Int FileChunk)
-> FileServerReplica
-> Either String (Map Int FileChunk)
addReplica (Map Int (FileSize Word32), Map Int FileDigest)
sd) (Map Int FileChunk -> Either String (Map Int FileChunk)
forall a b. b -> Either a b
Right Map Int FileChunk
forall k a. Map k a
M.empty)
    addReplica :: (Map Int (FileSize Word32), Map Int FileDigest) -> Either String (Map Int FileChunk) -> FileServerReplica -> Either String (Map Int FileChunk)
    addReplica :: (Map Int (FileSize Word32), Map Int FileDigest)
-> Either String (Map Int FileChunk)
-> FileServerReplica
-> Either String (Map Int FileChunk)
addReplica (Map Int (FileSize Word32), Map Int FileDigest)
_ (Left String
e) FileServerReplica
_ = String -> Either String (Map Int FileChunk)
forall a b. a -> Either a b
Left String
e
    addReplica (Map Int (FileSize Word32)
ms, Map Int FileDigest
md) (Right Map Int FileChunk
cs) FileServerReplica {Int
$sel:chunkNo:FileServerReplica :: FileServerReplica -> Int
chunkNo :: Int
chunkNo, XFTPServer
$sel:server:FileServerReplica :: FileServerReplica -> XFTPServer
server :: XFTPServer
server, ChunkReplicaId
$sel:replicaId:FileServerReplica :: FileServerReplica -> ChunkReplicaId
replicaId :: ChunkReplicaId
replicaId, APrivateAuthKey
$sel:replicaKey:FileServerReplica :: FileServerReplica -> APrivateAuthKey
replicaKey :: APrivateAuthKey
replicaKey} = do
      case Int -> Map Int FileChunk -> Maybe FileChunk
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
chunkNo Map Int FileChunk
cs of
        Just chunk :: FileChunk
chunk@FileChunk {[FileChunkReplica]
$sel:replicas:FileChunk :: FileChunk -> [FileChunkReplica]
replicas :: [FileChunkReplica]
replicas} ->
          let replica :: FileChunkReplica
replica = FileChunkReplica {XFTPServer
$sel:server:FileChunkReplica :: XFTPServer
server :: XFTPServer
server, ChunkReplicaId
$sel:replicaId:FileChunkReplica :: ChunkReplicaId
replicaId :: ChunkReplicaId
replicaId, APrivateAuthKey
$sel:replicaKey:FileChunkReplica :: APrivateAuthKey
replicaKey :: APrivateAuthKey
replicaKey}
           in Map Int FileChunk -> Either String (Map Int FileChunk)
forall a b. b -> Either a b
Right (Map Int FileChunk -> Either String (Map Int FileChunk))
-> Map Int FileChunk -> Either String (Map Int FileChunk)
forall a b. (a -> b) -> a -> b
$ Int -> FileChunk -> Map Int FileChunk -> Map Int FileChunk
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
chunkNo ((FileChunk
chunk :: FileChunk) {replicas = replica : replicas}) Map Int FileChunk
cs
        Maybe FileChunk
_ -> do
          case Int -> Map Int FileDigest -> Maybe FileDigest
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
chunkNo Map Int FileDigest
md of
            Just FileDigest
digest' ->
              let replica :: FileChunkReplica
replica = FileChunkReplica {XFTPServer
$sel:server:FileChunkReplica :: XFTPServer
server :: XFTPServer
server, ChunkReplicaId
$sel:replicaId:FileChunkReplica :: ChunkReplicaId
replicaId :: ChunkReplicaId
replicaId, APrivateAuthKey
$sel:replicaKey:FileChunkReplica :: APrivateAuthKey
replicaKey :: APrivateAuthKey
replicaKey}
                  chunkSize' :: FileSize Word32
chunkSize' = FileSize Word32 -> Maybe (FileSize Word32) -> FileSize Word32
forall a. a -> Maybe a -> a
fromMaybe FileSize Word32
defChunkSize (Maybe (FileSize Word32) -> FileSize Word32)
-> Maybe (FileSize Word32) -> FileSize Word32
forall a b. (a -> b) -> a -> b
$ Int -> Map Int (FileSize Word32) -> Maybe (FileSize Word32)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
chunkNo Map Int (FileSize Word32)
ms
                  chunk :: FileChunk
chunk = FileChunk {Int
$sel:chunkNo:FileChunk :: Int
chunkNo :: Int
chunkNo, $sel:digest:FileChunk :: FileDigest
digest = FileDigest
digest', $sel:chunkSize:FileChunk :: FileSize Word32
chunkSize = FileSize Word32
chunkSize', $sel:replicas:FileChunk :: [FileChunkReplica]
replicas = [FileChunkReplica
replica]}
               in Map Int FileChunk -> Either String (Map Int FileChunk)
forall a b. b -> Either a b
Right (Map Int FileChunk -> Either String (Map Int FileChunk))
-> Map Int FileChunk -> Either String (Map Int FileChunk)
forall a b. (a -> b) -> a -> b
$ Int -> FileChunk -> Map Int FileChunk -> Map Int FileChunk
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
chunkNo FileChunk
chunk Map Int FileChunk
cs
            Maybe FileDigest
_ -> String -> Either String (Map Int FileChunk)
forall a b. a -> Either a b
Left String
"no digest for chunk"
    reverseReplicas :: FileChunk -> FileChunk
reverseReplicas c :: FileChunk
c@FileChunk {[FileChunkReplica]
$sel:replicas:FileChunk :: FileChunk -> [FileChunkReplica]
replicas :: [FileChunkReplica]
replicas} = (FileChunk
c :: FileChunk) {replicas = reverse replicas}