-- | 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 = Server -> IO Server
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Server -> IO Server) -> Server -> IO Server
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
    res <- Conn -> String -> ByteString -> IO ByteString
post Conn
conn String
"allkeys/v1" (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [BS_Identity] -> ByteString
LBS.fromChunks [Builder -> BS_Identity
runBuilder (Builder -> BS_Identity) -> Builder -> BS_Identity
forall a b. (a -> b) -> a -> b
$ WithTypeReps (SendAllKeys Int) -> Builder
forall a. BinaryEx a => a -> Builder
putEx (WithTypeReps (SendAllKeys Int) -> Builder)
-> WithTypeReps (SendAllKeys Int) -> Builder
forall a b. (a -> b) -> a -> b
$ SendAllKeys TypeRep -> WithTypeReps (SendAllKeys Int)
forall (f :: * -> *).
Traversable f =>
f TypeRep -> WithTypeReps (f Int)
withTypeReps (SendAllKeys TypeRep -> WithTypeReps (SendAllKeys Int))
-> SendAllKeys TypeRep -> WithTypeReps (SendAllKeys Int)
forall a b. (a -> b) -> a -> b
$ Ver -> [(TypeRep, Ver)] -> SendAllKeys TypeRep
forall typ. Ver -> [(typ, Ver)] -> SendAllKeys typ
SendAllKeys Ver
ver [(TypeRep, Ver)]
typs]
    let RecvAllKeys ans = withoutKeys key $ getEx $ BS.concat $ LBS.toChunks res
    pure 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)]
_ = BuildTree Key -> IO (BuildTree Key)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BuildTree Key -> IO (BuildTree Key))
-> BuildTree Key -> IO (BuildTree Key)
forall a b. (a -> b) -> a -> b
$ [Key] -> [([BS_Identity], BuildTree Key)] -> BuildTree Key
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)]
_ = String -> IO ()
forall a. String -> IO a
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]
_  = (String, String, Key) -> IO ()
forall a. Show a => a -> IO ()
print (String
"SERVER", String
"Uploading key", Key
key)