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 a :: Conn
a b :: HashMap TypeRep (BinaryOp Key)
b c :: 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
conn key :: HashMap TypeRep (BinaryOp Key)
key ver :: Ver
ver) typs :: [(TypeRep, Ver)]
typs = do
ByteString
res <- Conn -> String -> ByteString -> IO ByteString
post Conn
conn "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 :: [(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 _ _ _ _ _ = 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 _ _ _ = String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "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 _ key :: Key
key _ _ _ _ _ = (String, String, Key) -> IO ()
forall a. Show a => a -> IO ()
print ("SERVER", "Uploading key", Key
key)