-- | 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 (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
    ByteString
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 [(Key, Ver, [Key], Bloom [BS_Identity])]
ans = HashMap TypeRep (BinaryOp Key)
-> WithKeys (RecvAllKeys Int) -> RecvAllKeys Key
forall (f :: * -> *).
HashMap TypeRep (BinaryOp Key) -> WithKeys (f Int) -> f Key
withoutKeys HashMap TypeRep (BinaryOp Key)
key (WithKeys (RecvAllKeys Int) -> RecvAllKeys Key)
-> WithKeys (RecvAllKeys Int) -> RecvAllKeys Key
forall a b. (a -> b) -> a -> b
$ BS_Identity -> WithKeys (RecvAllKeys Int)
forall a. BinaryEx a => BS_Identity -> a
getEx (BS_Identity -> WithKeys (RecvAllKeys Int))
-> BS_Identity -> WithKeys (RecvAllKeys Int)
forall a b. (a -> b) -> a -> b
$ [BS_Identity] -> BS_Identity
BS.concat ([BS_Identity] -> BS_Identity) -> [BS_Identity] -> BS_Identity
forall a b. (a -> b) -> a -> b
$ ByteString -> [BS_Identity]
LBS.toChunks ByteString
res
    [(Key, Ver, [Key], Bloom [BS_Identity])]
-> IO [(Key, Ver, [Key], Bloom [BS_Identity])]
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)]
_ = BuildTree Key -> IO (BuildTree Key)
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 (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)