{- Copyright 2016 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

{-# LANGUAGE OverloadedStrings #-}

module Storage.Network (
	networkStorage,
	networkStorageOverride,
) where

import Types
import Types.Storage
import Types.Server
import Storage.Local
import HTTP.Client
import HTTP.ProofOfWork
import System.FilePath

networkStorage :: StorageLevel -> Maybe LocalStorageDirectory -> Server -> Storage
networkStorage storagelevel localdir server = Storage
	{ storeShare = store server
	, retrieveShare = retrieve server
	, obscureShares = obscure server
	, countShares = count server
	, moveShares = move server
	, uploadQueue = Just $ localStorage storagelevel (storageDir localdir)
		("uploadqueue" </> name)
	, storageLevel = storagelevel
	, getServer = Just server
	}
  where
	ServerName name = serverName server

networkStorageOverride :: Maybe LocalStorageDirectory -> HostName -> Port -> IO (Maybe Storage)
networkStorageOverride lsd h p = return $ Just $
	networkStorage LocallyPreferred lsd $ Server
		{ serverName = ServerName h
		, serverAddress = [ServerAddress h p]
		, serverDesc = h
		}

store :: Server -> StorableObjectIdent -> Share -> IO StoreResult
store srv i (Share _n o) = 
	serverRequest srv StoreFailure id i $ \pow ->
		putObject i pow o

retrieve :: Server -> ShareNum -> StorableObjectIdent -> IO RetrieveResult
retrieve srv n i = 
	serverRequest srv RetrieveFailure (RetrieveSuccess . Share n) i $
		getObject i

-- | Servers should automatically obscure, so do nothing.
-- (Could upload chaff.)
obscure :: Server -> IO ObscureResult
obscure _ = return ObscureSuccess

count :: Server -> IO CountResult
count srv = serverRequest srv CountFailure id NoPOWIdent countObjects

-- | Not needed for servers.
move :: Server -> Storage -> IO [StoreResult]
move _ _ = error "move is not implemented for servers"