    -- | The endpoints on the server
    module Development.Shake.Internal.History.Cloud(
        Cloud, newCloud, addCloud, lookupCloud
        ) where

    import Development.Shake.Internal.Value
    import Development.Shake.Internal.Core.Database
    import Development.Shake.Internal.History.Types
    import Development.Shake.Internal.History.Network
    import Development.Shake.Internal.History.Server
    import Development.Shake.Internal.History.Bloom
    import Control.Concurrent.Extra
    import System.Time.Extra
    import Control.Monad
    import Control.Monad.IO.Class
    import Control.Monad.Trans.Maybe
    import Control.Monad.Trans.Class
    import General.Fence
    import qualified Data.HashMap.Strict as Map
    import Data.Typeable
    import Data.Either.Extra
    import General.Binary
    import General.Extra
    import General.Wait

    type Initial = Map.HashMap Key (Ver, [Key], Bloom [BS_Identity])

    data Cloud = Cloud Server (Locked () -> IO ()) (Fence Locked Initial)

    newLaterFence :: (Locked () -> IO ()) -> Seconds -> a -> IO a -> IO (Fence Locked a)
    newLaterFence :: (Locked () -> IO ()) -> Seconds -> a -> IO a -> IO (Fence Locked a)
    newLaterFence relock :: Locked () -> IO ()
    relock maxTime :: Seconds
    maxTime def :: a
    def act :: IO a
    act = do
        Fence Locked a
    fence <- IO (Fence Locked a)
    forall (m :: * -> *) a. MonadIO m => IO (Fence m a)
    newFence
        IO (Maybe a)
    -> (Either SomeException (Maybe a) -> IO ()) -> IO ThreadId
    forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
    forkFinally (Seconds -> IO a -> IO (Maybe a)
    forall a. Seconds -> IO a -> IO (Maybe a)
    timeout Seconds
    maxTime IO a
    act) ((Either SomeException (Maybe a) -> IO ()) -> IO ThreadId)
    -> (Either SomeException (Maybe a) -> IO ()) -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ \res :: Either SomeException (Maybe a)
    res -> Locked () -> IO ()
    relock (Locked () -> IO ()) -> Locked () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Fence Locked a -> a -> Locked ()
    forall (m :: * -> *) a.
    (Partial, MonadIO m) =>
    Fence m a -> a -> m ()
    signalFence Fence Locked a
    fence (a -> Locked ()) -> a -> Locked ()
    forall a b. (a -> b) -> a -> b
    $ case Either SomeException (Maybe a)
    res of
            Right (Just v :: a
    v) -> a
    v
            _ -> a
    def
        Fence Locked a -> IO (Fence Locked a)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Fence Locked a
    fence

    laterFence :: MonadIO m => Fence m a -> Wait m a
    laterFence :: Fence m a -> Wait m a
    laterFence fence :: Fence m a
    fence = do
        Maybe a
    res <- IO (Maybe a) -> Wait m (Maybe a)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe a) -> Wait m (Maybe a))
    -> IO (Maybe a) -> Wait m (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ Fence m a -> IO (Maybe a)
    forall (m :: * -> *) a. Fence m a -> IO (Maybe a)
    testFence Fence m a
    fence
        case Maybe a
    res of
            Just v :: a
    v -> a -> Wait m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    v
            Nothing -> ((a -> m ()) -> m ()) -> Wait m a
    forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Wait m a
    Later (((a -> m ()) -> m ()) -> Wait m a)
    -> ((a -> m ()) -> m ()) -> Wait m a
    forall a b. (a -> b) -> a -> b
    $ Fence m a -> (a -> m ()) -> m ()
    forall (m :: * -> *) a.
    MonadIO m =>
    Fence m a -> (a -> m ()) -> m ()
    waitFence Fence m a
    fence

    newCloud :: (Locked () -> IO ()) -> Map.HashMap TypeRep (BinaryOp Key) -> Ver -> [(TypeRep, Ver)] -> [String] -> Maybe (IO Cloud)
    newCloud :: (Locked () -> IO ())
    -> HashMap TypeRep (BinaryOp Key)
    -> Ver
    -> [(TypeRep, Ver)]
    -> [String]
    -> Maybe (IO Cloud)
    newCloud relock :: Locked () -> IO ()
    relock binop :: HashMap TypeRep (BinaryOp Key)
    binop globalVer :: Ver
    globalVer ruleVer :: [(TypeRep, Ver)]
    ruleVer urls :: [String]
    urls = ((IO Conn -> IO Cloud) -> Maybe (IO Conn) -> Maybe (IO Cloud))
    -> Maybe (IO Conn) -> (IO Conn -> IO Cloud) -> Maybe (IO Cloud)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (IO Conn -> IO Cloud) -> Maybe (IO Conn) -> Maybe (IO Cloud)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (if [String] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    urls then Maybe (IO Conn)
    forall a. Maybe a
    Nothing else String -> Maybe (IO Conn)
    connect (String -> Maybe (IO Conn)) -> String -> Maybe (IO Conn)
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall a. [a] -> a
    last [String]
    urls) ((IO Conn -> IO Cloud) -> Maybe (IO Cloud))
    -> (IO Conn -> IO Cloud) -> Maybe (IO Cloud)
    forall a b. (a -> b) -> a -> b
    $ \conn :: IO Conn
    conn -> do
        Conn
    conn <- IO Conn
    conn
        Server
    server <- Conn -> HashMap TypeRep (BinaryOp Key) -> Ver -> IO Server
    newServer Conn
    conn HashMap TypeRep (BinaryOp Key)
    binop Ver
    globalVer
        Fence Locked (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
    fence <- (Locked () -> IO ())
    -> Seconds
    -> HashMap Key (Ver, [Key], Bloom [BS_Identity])
    -> IO (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
    -> IO
         (Fence Locked (HashMap Key (Ver, [Key], Bloom [BS_Identity])))
    forall a.
    (Locked () -> IO ()) -> Seconds -> a -> IO a -> IO (Fence Locked a)
    newLaterFence Locked () -> IO ()
    relock 10 HashMap Key (Ver, [Key], Bloom [BS_Identity])
    forall k v. HashMap k v
    Map.empty (IO (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
     -> IO
          (Fence Locked (HashMap Key (Ver, [Key], Bloom [BS_Identity]))))
    -> IO (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
    -> IO
         (Fence Locked (HashMap Key (Ver, [Key], Bloom [BS_Identity])))
    forall a b. (a -> b) -> a -> b
    $ do
            [(Key, Ver, [Key], Bloom [BS_Identity])]
    xs <- Server
    -> [(TypeRep, Ver)] -> IO [(Key, Ver, [Key], Bloom [BS_Identity])]
    serverAllKeys Server
    server [(TypeRep, Ver)]
    ruleVer
            HashMap Key (Ver, [Key], Bloom [BS_Identity])
    -> IO (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (HashMap Key (Ver, [Key], Bloom [BS_Identity])
     -> IO (HashMap Key (Ver, [Key], Bloom [BS_Identity])))
    -> HashMap Key (Ver, [Key], Bloom [BS_Identity])
    -> IO (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
    forall a b. (a -> b) -> a -> b
    $ [(Key, (Ver, [Key], Bloom [BS_Identity]))]
    -> HashMap Key (Ver, [Key], Bloom [BS_Identity])
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    Map.fromList [(Key
    k,(Ver
    v,[Key]
    ds,Bloom [BS_Identity]
    test)) | (k :: Key
    k,v :: Ver
    v,ds :: [Key]
    ds,test :: Bloom [BS_Identity]
    test) <- [(Key, Ver, [Key], Bloom [BS_Identity])]
    xs]
        Cloud -> IO Cloud
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Cloud -> IO Cloud) -> Cloud -> IO Cloud
    forall a b. (a -> b) -> a -> b
    $ Server
    -> (Locked () -> IO ())
    -> Fence Locked (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
    -> Cloud
    Cloud Server
    server Locked () -> IO ()
    relock Fence Locked (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
    fence

    addCloud :: Cloud -> Key -> Ver -> Ver -> [[(Key, BS_Identity)]] -> BS_Store -> [FilePath] -> IO ()
    addCloud :: Cloud
    -> Key
    -> Ver
    -> Ver
    -> [[(Key, BS_Identity)]]
    -> BS_Identity
    -> [String]
    -> IO ()
    addCloud (Cloud server :: Server
    server _ _) x1 :: Key
    x1 x2 :: Ver
    x2 x3 :: Ver
    x3 x4 :: [[(Key, BS_Identity)]]
    x4 x5 :: BS_Identity
    x5 x6 :: [String]
    x6 = IO ThreadId -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ Server
    -> Key
    -> Ver
    -> Ver
    -> [[(Key, BS_Identity)]]
    -> BS_Identity
    -> [String]
    -> IO ()
    serverUpload Server
    server Key
    x1 Ver
    x2 Ver
    x3 [[(Key, BS_Identity)]]
    x4 BS_Identity
    x5 [String]
    x6

    lookupCloud :: Cloud -> (Key -> Wait Locked (Maybe BS_Identity)) -> Key -> Ver -> Ver -> Wait Locked (Maybe (BS_Store, [[Key]], IO ()))
    lookupCloud :: Cloud
    -> (Key -> Wait Locked (Maybe BS_Identity))
    -> Key
    -> Ver
    -> Ver
    -> Wait Locked (Maybe (BS_Identity, [[Key]], IO ()))
    lookupCloud (Cloud server :: Server
    server relock :: Locked () -> IO ()
    relock initial :: Fence Locked (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
    initial) ask :: Key -> Wait Locked (Maybe BS_Identity)
    ask key :: Key
    key builtinVer :: Ver
    builtinVer userVer :: Ver
    userVer = MaybeT (Wait Locked) (BS_Identity, [[Key]], IO ())
    -> Wait Locked (Maybe (BS_Identity, [[Key]], IO ()))
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT (Wait Locked) (BS_Identity, [[Key]], IO ())
     -> Wait Locked (Maybe (BS_Identity, [[Key]], IO ())))
    -> MaybeT (Wait Locked) (BS_Identity, [[Key]], IO ())
    -> Wait Locked (Maybe (BS_Identity, [[Key]], IO ()))
    forall a b. (a -> b) -> a -> b
    $ do
        HashMap Key (Ver, [Key], Bloom [BS_Identity])
    mp <- Wait Locked (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
    -> MaybeT
         (Wait Locked) (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Wait Locked (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
     -> MaybeT
          (Wait Locked) (HashMap Key (Ver, [Key], Bloom [BS_Identity])))
    -> Wait Locked (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
    -> MaybeT
         (Wait Locked) (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
    forall a b. (a -> b) -> a -> b
    $ Fence Locked (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
    -> Wait Locked (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
    forall (m :: * -> *) a. MonadIO m => Fence m a -> Wait m a
    laterFence Fence Locked (HashMap Key (Ver, [Key], Bloom [BS_Identity]))
    initial
        Just (ver :: Ver
    ver, deps :: [Key]
    deps, bloom :: Bloom [BS_Identity]
    bloom)<- Maybe (Ver, [Key], Bloom [BS_Identity])
    -> MaybeT (Wait Locked) (Maybe (Ver, [Key], Bloom [BS_Identity]))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe (Ver, [Key], Bloom [BS_Identity])
     -> MaybeT (Wait Locked) (Maybe (Ver, [Key], Bloom [BS_Identity])))
    -> Maybe (Ver, [Key], Bloom [BS_Identity])
    -> MaybeT (Wait Locked) (Maybe (Ver, [Key], Bloom [BS_Identity]))
    forall a b. (a -> b) -> a -> b
    $ Key
    -> HashMap Key (Ver, [Key], Bloom [BS_Identity])
    -> Maybe (Ver, [Key], Bloom [BS_Identity])
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup Key
    key HashMap Key (Ver, [Key], Bloom [BS_Identity])
    mp
        Bool -> MaybeT (Wait Locked) () -> MaybeT (Wait Locked) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Ver
    ver Ver -> Ver -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ver
    userVer) (MaybeT (Wait Locked) () -> MaybeT (Wait Locked) ())
    -> MaybeT (Wait Locked) () -> MaybeT (Wait Locked) ()
    forall a b. (a -> b) -> a -> b
    $ String -> MaybeT (Wait Locked) ()
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail ""
        Right vs :: [BS_Identity]
    vs <- Wait Locked (Either () [BS_Identity])
    -> MaybeT (Wait Locked) (Either () [BS_Identity])
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Wait Locked (Either () [BS_Identity])
     -> MaybeT (Wait Locked) (Either () [BS_Identity]))
    -> Wait Locked (Either () [BS_Identity])
    -> MaybeT (Wait Locked) (Either () [BS_Identity])
    forall a b. (a -> b) -> a -> b
    $ (Key -> Wait Locked (Either () BS_Identity))
    -> [Key] -> Wait Locked (Either () [BS_Identity])
    forall (m :: * -> *) a e b.
    MonadIO m =>
    (a -> Wait m (Either e b)) -> [a] -> Wait m (Either e [b])
    firstLeftWaitUnordered ((Maybe BS_Identity -> Either () BS_Identity)
    -> Wait Locked (Maybe BS_Identity)
    -> Wait Locked (Either () BS_Identity)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (() -> Maybe BS_Identity -> Either () BS_Identity
    forall a b. a -> Maybe b -> Either a b
    maybeToEither ()) (Wait Locked (Maybe BS_Identity)
     -> Wait Locked (Either () BS_Identity))
    -> (Key -> Wait Locked (Maybe BS_Identity))
    -> Key
    -> Wait Locked (Either () BS_Identity)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Key -> Wait Locked (Maybe BS_Identity)
    ask) [Key]
    deps
        Bool -> MaybeT (Wait Locked) () -> MaybeT (Wait Locked) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Bloom [BS_Identity] -> [BS_Identity] -> Bool
    forall a. Hashable a => Bloom a -> a -> Bool
    bloomTest Bloom [BS_Identity]
    bloom [BS_Identity]
    vs) (MaybeT (Wait Locked) () -> MaybeT (Wait Locked) ())
    -> MaybeT (Wait Locked) () -> MaybeT (Wait Locked) ()
    forall a b. (a -> b) -> a -> b
    $ String -> MaybeT (Wait Locked) ()
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail ""
        Fence Locked (BuildTree Key)
    fence <- IO (Fence Locked (BuildTree Key))
    -> MaybeT (Wait Locked) (Fence Locked (BuildTree Key))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Fence Locked (BuildTree Key))
     -> MaybeT (Wait Locked) (Fence Locked (BuildTree Key)))
    -> IO (Fence Locked (BuildTree Key))
    -> MaybeT (Wait Locked) (Fence Locked (BuildTree Key))
    forall a b. (a -> b) -> a -> b
    $ (Locked () -> IO ())
    -> Seconds
    -> BuildTree Key
    -> IO (BuildTree Key)
    -> IO (Fence Locked (BuildTree Key))
    forall a.
    (Locked () -> IO ()) -> Seconds -> a -> IO a -> IO (Fence Locked a)
    newLaterFence Locked () -> IO ()
    relock 10 BuildTree Key
    forall a. Monoid a => a
    mempty (IO (BuildTree Key) -> IO (Fence Locked (BuildTree Key)))
    -> IO (BuildTree Key) -> IO (Fence Locked (BuildTree Key))
    forall a b. (a -> b) -> a -> b
    $ Server
    -> Key -> Ver -> Ver -> [(Key, BS_Identity)] -> IO (BuildTree Key)
    serverOneKey Server
    server Key
    key Ver
    builtinVer Ver
    userVer ([(Key, BS_Identity)] -> IO (BuildTree Key))
    -> [(Key, BS_Identity)] -> IO (BuildTree Key)
    forall a b. (a -> b) -> a -> b
    $ [Key] -> [BS_Identity] -> [(Key, BS_Identity)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Key]
    deps [BS_Identity]
    vs
        BuildTree Key
    tree <- Wait Locked (BuildTree Key) -> MaybeT (Wait Locked) (BuildTree Key)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Wait Locked (BuildTree Key)
     -> MaybeT (Wait Locked) (BuildTree Key))
    -> Wait Locked (BuildTree Key)
    -> MaybeT (Wait Locked) (BuildTree Key)
    forall a b. (a -> b) -> a -> b
    $ Fence Locked (BuildTree Key) -> Wait Locked (BuildTree Key)
    forall (m :: * -> *) a. MonadIO m => Fence m a -> Wait m a
    laterFence Fence Locked (BuildTree Key)
    fence
        [[Key]]
    -> BuildTree Key
    -> MaybeT (Wait Locked) (BS_Identity, [[Key]], IO ())
    f [[Key]
    deps] BuildTree Key
    tree
        where
            f :: [[Key]] -> BuildTree Key -> MaybeT (Wait Locked) (BS_Store, [[Key]], IO ())
            f :: [[Key]]
    -> BuildTree Key
    -> MaybeT (Wait Locked) (BS_Identity, [[Key]], IO ())
    f ks :: [[Key]]
    ks (Done store :: BS_Identity
    store xs :: [(String, FileSize, FileHash)]
    xs) = (BS_Identity, [[Key]], IO ())
    -> MaybeT (Wait Locked) (BS_Identity, [[Key]], IO ())
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (BS_Identity
    store, [[Key]] -> [[Key]]
    forall a. [a] -> [a]
    reverse [[Key]]
    ks, Server -> Key -> [(String, FileSize, FileHash)] -> IO ()
    serverDownloadFiles Server
    server Key
    key [(String, FileSize, FileHash)]
    xs)
            f ks :: [[Key]]
    ks (Depend deps :: [Key]
    deps trees :: [([BS_Identity], BuildTree Key)]
    trees) = do
                Right vs :: [BS_Identity]
    vs <- Wait Locked (Either () [BS_Identity])
    -> MaybeT (Wait Locked) (Either () [BS_Identity])
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Wait Locked (Either () [BS_Identity])
     -> MaybeT (Wait Locked) (Either () [BS_Identity]))
    -> Wait Locked (Either () [BS_Identity])
    -> MaybeT (Wait Locked) (Either () [BS_Identity])
    forall a b. (a -> b) -> a -> b
    $ (Key -> Wait Locked (Either () BS_Identity))
    -> [Key] -> Wait Locked (Either () [BS_Identity])
    forall (m :: * -> *) a e b.
    MonadIO m =>
    (a -> Wait m (Either e b)) -> [a] -> Wait m (Either e [b])
    firstLeftWaitUnordered ((Maybe BS_Identity -> Either () BS_Identity)
    -> Wait Locked (Maybe BS_Identity)
    -> Wait Locked (Either () BS_Identity)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (() -> Maybe BS_Identity -> Either () BS_Identity
    forall a b. a -> Maybe b -> Either a b
    maybeToEither ()) (Wait Locked (Maybe BS_Identity)
     -> Wait Locked (Either () BS_Identity))
    -> (Key -> Wait Locked (Maybe BS_Identity))
    -> Key
    -> Wait Locked (Either () BS_Identity)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Key -> Wait Locked (Maybe BS_Identity)
    ask) [Key]
    deps
                Just tree :: BuildTree Key
    tree<- Maybe (BuildTree Key)
    -> MaybeT (Wait Locked) (Maybe (BuildTree Key))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe (BuildTree Key)
     -> MaybeT (Wait Locked) (Maybe (BuildTree Key)))
    -> Maybe (BuildTree Key)
    -> MaybeT (Wait Locked) (Maybe (BuildTree Key))
    forall a b. (a -> b) -> a -> b
    $ [BS_Identity]
    -> [([BS_Identity], BuildTree Key)] -> Maybe (BuildTree Key)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup [BS_Identity]
    vs [([BS_Identity], BuildTree Key)]
    trees
                [[Key]]
    -> BuildTree Key
    -> MaybeT (Wait Locked) (BS_Identity, [[Key]], IO ())
    f ([Key]
    deps[Key] -> [[Key]] -> [[Key]]
    forall a. a -> [a] -> [a]
    :[[Key]]
    ks) BuildTree Key
    tree