-- | The endpoints on the cloud server
module Development.Shake.Internal.History.Server(
    Server, BuildTree(..),
    newServer,
    serverAllKeys, serverOneKey, serverDownloadFiles,
    serverUpload
    ) where

import Development.Shake.Internal.History.Bloom
import Development.Shake.Internal.History.Serialise
import Development.Shake.Internal.Value
import General.Binary
import General.Extra
import qualified Data.HashMap.Strict as Map
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString as BS
import Development.Shake.Internal.FileInfo
import Development.Shake.Internal.History.Types
import Development.Shake.Internal.History.Network
import Data.Typeable


data Server = Server Conn (Map.HashMap TypeRep (BinaryOp Key)) Ver

newServer :: Conn -> Map.HashMap TypeRep (BinaryOp Key) -> Ver -> IO Server
newServer :: Conn -> HashMap TypeRep (BinaryOp Key) -> Ver -> IO Server
newServer Conn
a HashMap TypeRep (BinaryOp Key)
b Ver
c = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Conn -> HashMap TypeRep (BinaryOp Key) -> Ver -> Server
Server Conn
a HashMap TypeRep (BinaryOp Key)
b Ver
c

serverAllKeys :: Server -> [(TypeRep, Ver)] -> IO [(Key, Ver, [Key], Bloom [BS_Identity])]
serverAllKeys :: Server
-> [(TypeRep, Ver)] -> IO [(Key, Ver, [Key], Bloom [BS_Identity])]
serverAllKeys (Server Conn
conn HashMap TypeRep (BinaryOp Key)
key Ver
ver) [(TypeRep, Ver)]
typs = do
    ByteString
res <- Conn -> String -> ByteString -> IO ByteString
post Conn
conn String
"allkeys/v1" forall a b. (a -> b) -> a -> b
$ [BS_Identity] -> ByteString
LBS.fromChunks [Builder -> BS_Identity
runBuilder forall a b. (a -> b) -> a -> b
$ forall a. BinaryEx a => a -> Builder
putEx forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Traversable f =>
f TypeRep -> WithTypeReps (f Int)
withTypeReps forall a b. (a -> b) -> a -> b
$ forall typ. Ver -> [(typ, Ver)] -> SendAllKeys typ
SendAllKeys Ver
ver [(TypeRep, Ver)]
typs]
    let RecvAllKeys [(Key, Ver, [Key], Bloom [BS_Identity])]
ans = forall (f :: * -> *).
HashMap TypeRep (BinaryOp Key) -> WithKeys (f Int) -> f Key
withoutKeys HashMap TypeRep (BinaryOp Key)
key forall a b. (a -> b) -> a -> b
$ forall a. BinaryEx a => BS_Identity -> a
getEx forall a b. (a -> b) -> a -> b
$ [BS_Identity] -> BS_Identity
BS.concat forall a b. (a -> b) -> a -> b
$ ByteString -> [BS_Identity]
LBS.toChunks ByteString
res
    forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Key, Ver, [Key], Bloom [BS_Identity])]
ans

serverOneKey :: Server -> Key -> Ver -> Ver -> [(Key, BS_Identity)] -> IO (BuildTree Key)
serverOneKey :: Server
-> Key -> Ver -> Ver -> [(Key, BS_Identity)] -> IO (BuildTree Key)
serverOneKey Server
_ Key
_ Ver
_ Ver
_ [(Key, BS_Identity)]
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall key.
[key] -> [([BS_Identity], BuildTree key)] -> BuildTree key
Depend [] []


serverDownloadFiles :: Server -> Key -> [(FilePath, FileSize, FileHash)] -> IO ()
serverDownloadFiles :: Server -> Key -> [(String, FileSize, FileHash)] -> IO ()
serverDownloadFiles Server
_ Key
_ [(String, FileSize, FileHash)]
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failed to download the files"


serverUpload :: Server -> Key -> Ver -> Ver -> [[(Key, BS_Identity)]] -> BS_Store -> [FilePath] -> IO ()
serverUpload :: Server
-> Key
-> Ver
-> Ver
-> [[(Key, BS_Identity)]]
-> BS_Identity
-> [String]
-> IO ()
serverUpload Server
_ Key
key Ver
_ Ver
_ [[(Key, BS_Identity)]]
_ BS_Identity
_ [String]
_  = forall a. Show a => a -> IO ()
print (String
"SERVER", String
"Uploading key", Key
key)