{- | Functionality related to acting as a client for the Great Black Swamp
 protocol.
-}
module Tahoe.Download.Internal.Client where

import Control.Exception
import Control.Monad.IO.Class
import qualified Data.ByteString as B
import Data.ByteString.Base32
import qualified Data.ByteString.Base64 as Base64
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text.Encoding
import Network.Connection
import Network.HTTP.Client (Manager, ManagerSettings (managerModifyRequest), Request (requestHeaders))
import Network.HTTP.Client.TLS
import Network.HTTP.Types (ByteRange)
import Servant.Client
import Tahoe.Announcement
import Tahoe.CHK.Server (
    StorageServer (..),
 )
import TahoeLAFS.Storage.API (CBORSet (CBORSet), ShareNumber (ShareNumber))
import Text.Read (readMaybe)

-- | Make an HTTPS URL.
https :: String -> Int -> BaseUrl
https :: String -> Int -> BaseUrl
https String
host Int
port =
    BaseUrl :: Scheme -> String -> Int -> String -> BaseUrl
BaseUrl
        { baseUrlScheme :: Scheme
baseUrlScheme = Scheme
Https
        , baseUrlHost :: String
baseUrlHost = String
host
        , baseUrlPort :: Int
baseUrlPort = Int
port
        , baseUrlPath :: String
baseUrlPath = String
""
        }

{- | Make an HTTPS manager for the given SPKI hash and swissnum.

 The SPKI hash is _not_ used to authenticate the server!  See
 https://whetstone.private.storage/privatestorage/tahoe-great-black-swamp/-/issues/27
-}
managerSettingsForService :: T.Text -> T.Text -> ManagerSettings
managerSettingsForService :: Text -> Text -> ManagerSettings
managerSettingsForService Text
_ Text
swissnum =
    (TLSSettings -> Maybe SockSettings -> ManagerSettings
mkManagerSettings TLSSettings
tlsSettings Maybe SockSettings
forall a. Maybe a
sockSettings){managerModifyRequest :: Request -> IO Request
managerModifyRequest = Request -> IO Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request -> IO Request)
-> (Request -> Request) -> Request -> IO Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
authorize}
  where
    tlsSettings :: TLSSettings
tlsSettings = Bool -> Bool -> Bool -> TLSSettings
TLSSettingsSimple Bool
True Bool
True Bool
True
    sockSettings :: Maybe a
sockSettings = Maybe a
forall a. Maybe a
Nothing
    swissnumBytes :: ByteString
swissnumBytes = Text -> ByteString
encodeUtf8 Text
swissnum
    swissnumBase64 :: ByteString
swissnumBase64 = ByteString -> ByteString
Base64.encode ByteString
swissnumBytes
    headerCompleteBytes :: ByteString
headerCompleteBytes = [ByteString] -> ByteString
B.concat [ByteString
"Tahoe-LAFS ", ByteString
swissnumBase64]
    authorize :: Request -> Request
authorize Request
req =
        Request
req
            { requestHeaders :: RequestHeaders
requestHeaders =
                ( HeaderName
"Authorization"
                , ByteString
headerCompleteBytes
                ) (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
:
                Request -> RequestHeaders
requestHeaders Request
req
            }

-- | Make a manager suitable for use with a Great Black Swamp server.
newGBSManager ::
    MonadIO m =>
    [Char] ->
    String ->
    m Manager
newGBSManager :: String -> String -> m Manager
newGBSManager String
tubid String
swissnum =
    ManagerSettings -> m Manager
forall (m :: * -> *). MonadIO m => ManagerSettings -> m Manager
newTlsManagerWith (ManagerSettings -> m Manager) -> ManagerSettings -> m Manager
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> ManagerSettings
managerSettingsForService
            (String -> Text
T.pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
init (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
tubid)
            (String -> Text
T.pack String
swissnum)

{- | An unrecoverable problem arose while attempting to download and/or read
 some application data.
-}
data DownloadError
    = -- | The configuration included no candidate servers from which to download.
      NoConfiguredServers
    | -- | Across all of the configured servers, none were actually connectable.
      NoReachableServers [DiscoverError]
    | -- | Across all of the configured servers, fewer than the required
      -- number of shares were found. XXX Could split this into the different
      -- cases - did not locate enough shares, did not download enough shares,
      -- did not verify enough shares
      NotEnoughShares
        { DownloadError -> Int
notEnoughSharesNeeded :: Int
        , DownloadError -> Int
notEnoughSharesFound :: Int
        }
    | -- | Across all of the shares that we could download, fewer than the
      -- required number could actually be decoded.
      NotEnoughDecodedShares
        { DownloadError -> Int
notEnoughDecodedSharesNeeded :: Int
        , DownloadError -> Int
notEnoughDecodedSharesFound :: Int
        }
    | -- | Enough syntactically valid shares were recovered but they could not
      -- be interpreted.
      ShareDecodingFailed
    | -- | An attempt was made to download a share but no servers were given for
      -- the download.
      NoServers
    | -- | An error occurred during share download.
      ShareDownloadError String
    deriving (DownloadError -> DownloadError -> Bool
(DownloadError -> DownloadError -> Bool)
-> (DownloadError -> DownloadError -> Bool) -> Eq DownloadError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DownloadError -> DownloadError -> Bool
$c/= :: DownloadError -> DownloadError -> Bool
== :: DownloadError -> DownloadError -> Bool
$c== :: DownloadError -> DownloadError -> Bool
Eq, Eq DownloadError
Eq DownloadError
-> (DownloadError -> DownloadError -> Ordering)
-> (DownloadError -> DownloadError -> Bool)
-> (DownloadError -> DownloadError -> Bool)
-> (DownloadError -> DownloadError -> Bool)
-> (DownloadError -> DownloadError -> Bool)
-> (DownloadError -> DownloadError -> DownloadError)
-> (DownloadError -> DownloadError -> DownloadError)
-> Ord DownloadError
DownloadError -> DownloadError -> Bool
DownloadError -> DownloadError -> Ordering
DownloadError -> DownloadError -> DownloadError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DownloadError -> DownloadError -> DownloadError
$cmin :: DownloadError -> DownloadError -> DownloadError
max :: DownloadError -> DownloadError -> DownloadError
$cmax :: DownloadError -> DownloadError -> DownloadError
>= :: DownloadError -> DownloadError -> Bool
$c>= :: DownloadError -> DownloadError -> Bool
> :: DownloadError -> DownloadError -> Bool
$c> :: DownloadError -> DownloadError -> Bool
<= :: DownloadError -> DownloadError -> Bool
$c<= :: DownloadError -> DownloadError -> Bool
< :: DownloadError -> DownloadError -> Bool
$c< :: DownloadError -> DownloadError -> Bool
compare :: DownloadError -> DownloadError -> Ordering
$ccompare :: DownloadError -> DownloadError -> Ordering
$cp1Ord :: Eq DownloadError
Ord, Int -> DownloadError -> String -> String
[DownloadError] -> String -> String
DownloadError -> String
(Int -> DownloadError -> String -> String)
-> (DownloadError -> String)
-> ([DownloadError] -> String -> String)
-> Show DownloadError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DownloadError] -> String -> String
$cshowList :: [DownloadError] -> String -> String
show :: DownloadError -> String
$cshow :: DownloadError -> String
showsPrec :: Int -> DownloadError -> String -> String
$cshowsPrec :: Int -> DownloadError -> String -> String
Show)

{- | A problem arose while attempting to discover the shares held on a
 particular server.
-}
data DiscoverError
    = -- | An announcement did not include a location for a connection attempt.
      StorageServerLocationUnknown
    | -- | An announcement included a location we could not interpret.
      StorageServerLocationUnsupported
    | StorageServerUnreachable LookupError
    | StorageServerCommunicationError String
    deriving (DiscoverError -> DiscoverError -> Bool
(DiscoverError -> DiscoverError -> Bool)
-> (DiscoverError -> DiscoverError -> Bool) -> Eq DiscoverError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiscoverError -> DiscoverError -> Bool
$c/= :: DiscoverError -> DiscoverError -> Bool
== :: DiscoverError -> DiscoverError -> Bool
$c== :: DiscoverError -> DiscoverError -> Bool
Eq, Eq DiscoverError
Eq DiscoverError
-> (DiscoverError -> DiscoverError -> Ordering)
-> (DiscoverError -> DiscoverError -> Bool)
-> (DiscoverError -> DiscoverError -> Bool)
-> (DiscoverError -> DiscoverError -> Bool)
-> (DiscoverError -> DiscoverError -> Bool)
-> (DiscoverError -> DiscoverError -> DiscoverError)
-> (DiscoverError -> DiscoverError -> DiscoverError)
-> Ord DiscoverError
DiscoverError -> DiscoverError -> Bool
DiscoverError -> DiscoverError -> Ordering
DiscoverError -> DiscoverError -> DiscoverError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DiscoverError -> DiscoverError -> DiscoverError
$cmin :: DiscoverError -> DiscoverError -> DiscoverError
max :: DiscoverError -> DiscoverError -> DiscoverError
$cmax :: DiscoverError -> DiscoverError -> DiscoverError
>= :: DiscoverError -> DiscoverError -> Bool
$c>= :: DiscoverError -> DiscoverError -> Bool
> :: DiscoverError -> DiscoverError -> Bool
$c> :: DiscoverError -> DiscoverError -> Bool
<= :: DiscoverError -> DiscoverError -> Bool
$c<= :: DiscoverError -> DiscoverError -> Bool
< :: DiscoverError -> DiscoverError -> Bool
$c< :: DiscoverError -> DiscoverError -> Bool
compare :: DiscoverError -> DiscoverError -> Ordering
$ccompare :: DiscoverError -> DiscoverError -> Ordering
$cp1Ord :: Eq DiscoverError
Ord, Int -> DiscoverError -> String -> String
[DiscoverError] -> String -> String
DiscoverError -> String
(Int -> DiscoverError -> String -> String)
-> (DiscoverError -> String)
-> ([DiscoverError] -> String -> String)
-> Show DiscoverError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DiscoverError] -> String -> String
$cshowList :: [DiscoverError] -> String -> String
show :: DiscoverError -> String
$cshow :: DiscoverError -> String
showsPrec :: Int -> DiscoverError -> String -> String
$cshowsPrec :: Int -> DiscoverError -> String -> String
Show)

{- | The type of a function that can produce a concrete StorageServer from
 that server's announcement.
-}
type LookupServer m = StorageServerAnnouncement -> m (Either LookupError StorageServer)

-- | There was a problem while trying to look up a server from its announcement.
data LookupError
    = -- | The server's announced URI was unparseable.
      URIParseError StorageServerAnnouncement
    | -- | The port integer in the server's URI was unparseable.
      PortParseError String
    | -- | The structure of the server's URI was unparseable.
      AnnouncementStructureUnmatched
    deriving (LookupError -> LookupError -> Bool
(LookupError -> LookupError -> Bool)
-> (LookupError -> LookupError -> Bool) -> Eq LookupError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LookupError -> LookupError -> Bool
$c/= :: LookupError -> LookupError -> Bool
== :: LookupError -> LookupError -> Bool
$c== :: LookupError -> LookupError -> Bool
Eq, Eq LookupError
Eq LookupError
-> (LookupError -> LookupError -> Ordering)
-> (LookupError -> LookupError -> Bool)
-> (LookupError -> LookupError -> Bool)
-> (LookupError -> LookupError -> Bool)
-> (LookupError -> LookupError -> Bool)
-> (LookupError -> LookupError -> LookupError)
-> (LookupError -> LookupError -> LookupError)
-> Ord LookupError
LookupError -> LookupError -> Bool
LookupError -> LookupError -> Ordering
LookupError -> LookupError -> LookupError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LookupError -> LookupError -> LookupError
$cmin :: LookupError -> LookupError -> LookupError
max :: LookupError -> LookupError -> LookupError
$cmax :: LookupError -> LookupError -> LookupError
>= :: LookupError -> LookupError -> Bool
$c>= :: LookupError -> LookupError -> Bool
> :: LookupError -> LookupError -> Bool
$c> :: LookupError -> LookupError -> Bool
<= :: LookupError -> LookupError -> Bool
$c<= :: LookupError -> LookupError -> Bool
< :: LookupError -> LookupError -> Bool
$c< :: LookupError -> LookupError -> Bool
compare :: LookupError -> LookupError -> Ordering
$ccompare :: LookupError -> LookupError -> Ordering
$cp1Ord :: Eq LookupError
Ord, Int -> LookupError -> String -> String
[LookupError] -> String -> String
LookupError -> String
(Int -> LookupError -> String -> String)
-> (LookupError -> String)
-> ([LookupError] -> String -> String)
-> Show LookupError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LookupError] -> String -> String
$cshowList :: [LookupError] -> String -> String
show :: LookupError -> String
$cshow :: LookupError -> String
showsPrec :: Int -> LookupError -> String -> String
$cshowsPrec :: Int -> LookupError -> String -> String
Show)

{- | A problem was encountered attempting to deserialize bytes to a structured
 representation of some value.
-}
data DeserializeError = UnknownDeserializeError -- add more later?

type GetShareNumbers = String -> ClientM (CBORSet ShareNumber)
type ReadShare = String -> ShareNumber -> Maybe [ByteRange] -> ClientM B.ByteString

{- | Create a StorageServer that will speak Great Black Swamp using the given
 manager to the server at the given host/port.
-}
mkWrapper :: GetShareNumbers -> ReadShare -> Manager -> [Char] -> Int -> StorageServer
mkWrapper :: GetShareNumbers
-> ReadShare -> Manager -> String -> Int -> StorageServer
mkWrapper GetShareNumbers
getShareNumbers ReadShare
readShare Manager
manager String
host Int
realPort =
    StorageServer :: Text
-> (ByteString -> ShareNum -> Offset -> ByteString -> IO ())
-> (ByteString -> ShareNum -> IO ByteString)
-> (ByteString -> IO (Set ShareNum))
-> StorageServer
StorageServer{Text
ByteString -> IO (Set ShareNum)
ByteString -> ShareNum -> IO ByteString
ByteString -> ShareNum -> Offset -> ByteString -> IO ()
forall a. a
forall a. Integral a => ByteString -> a -> IO ByteString
forall b. (Ord b, Num b) => ByteString -> IO (Set b)
storageServerWrite :: ByteString -> ShareNum -> Offset -> ByteString -> IO ()
storageServerRead :: ByteString -> ShareNum -> IO ByteString
storageServerID :: Text
storageServerGetBuckets :: ByteString -> IO (Set ShareNum)
storageServerGetBuckets :: forall b. (Ord b, Num b) => ByteString -> IO (Set b)
storageServerRead :: forall a. Integral a => ByteString -> a -> IO ByteString
storageServerWrite :: forall a. a
storageServerID :: forall a. a
..}
  where
    baseUrl :: BaseUrl
baseUrl = String -> Int -> BaseUrl
https String
host Int
realPort
    env :: ClientEnv
env = Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
manager BaseUrl
baseUrl
    toBase32 :: ByteString -> String
toBase32 = Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeBase32Unpadded

    storageServerID :: a
storageServerID = a
forall a. HasCallStack => a
undefined

    storageServerWrite :: a
storageServerWrite = a
forall a. HasCallStack => a
undefined

    storageServerRead :: ByteString -> a -> IO ByteString
storageServerRead ByteString
storageIndex a
shareNum = do
        let clientm :: ClientM ByteString
clientm = ReadShare
readShare (ByteString -> String
toBase32 ByteString
storageIndex) (Offset -> ShareNumber
ShareNumber (Offset -> ShareNumber) -> Offset -> ShareNumber
forall a b. (a -> b) -> a -> b
$ a -> Offset
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
shareNum) Maybe [ByteRange]
forall a. Maybe a
Nothing
        Either ClientError ByteString
res <- ClientM ByteString
-> ClientEnv -> IO (Either ClientError ByteString)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM ByteString
clientm ClientEnv
env
        case Either ClientError ByteString
res of
            Left ClientError
err -> do
                ClientError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO ClientError
err
            Right ByteString
bs -> ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs

    storageServerGetBuckets :: ByteString -> IO (Set b)
storageServerGetBuckets ByteString
storageIndex = do
        let clientm :: ClientM (CBORSet ShareNumber)
clientm = GetShareNumbers
getShareNumbers (ByteString -> String
toBase32 ByteString
storageIndex)
        Either SomeException (Either ClientError (CBORSet ShareNumber))
r <- IO (Either ClientError (CBORSet ShareNumber))
-> IO
     (Either SomeException (Either ClientError (CBORSet ShareNumber)))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Either ClientError (CBORSet ShareNumber))
 -> IO
      (Either SomeException (Either ClientError (CBORSet ShareNumber))))
-> IO (Either ClientError (CBORSet ShareNumber))
-> IO
     (Either SomeException (Either ClientError (CBORSet ShareNumber)))
forall a b. (a -> b) -> a -> b
$ ClientM (CBORSet ShareNumber)
-> ClientEnv -> IO (Either ClientError (CBORSet ShareNumber))
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM (CBORSet ShareNumber)
clientm ClientEnv
env
        case Either SomeException (Either ClientError (CBORSet ShareNumber))
r of
            Left (SomeException
_ :: SomeException) -> do
                Set b -> IO (Set b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set b
forall a. Monoid a => a
mempty
            Right Either ClientError (CBORSet ShareNumber)
res -> do
                case Either ClientError (CBORSet ShareNumber)
res of
                    Left ClientError
err -> do
                        ClientError -> IO (Set b)
forall e a. Exception e => e -> IO a
throwIO ClientError
err
                    Right (CBORSet Set ShareNumber
s) -> Set b -> IO (Set b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set b -> IO (Set b)) -> Set b -> IO (Set b)
forall a b. (a -> b) -> a -> b
$ (ShareNumber -> b) -> Set ShareNumber -> Set b
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\(ShareNumber Offset
i) -> Offset -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Offset
i) Set ShareNumber
s -- XXX fromIntegral aaaaaaaa!!

{- | If possible, populate a StorageServer with functions for operating on data
  on the server at the given URI.
-}
makeServer :: MonadIO m => GetShareNumbers -> ReadShare -> URI -> m (Either LookupError StorageServer)
makeServer :: GetShareNumbers
-> ReadShare -> URI -> m (Either LookupError StorageServer)
makeServer
    GetShareNumbers
getShareNumbers
    ReadShare
readShare
    URI
        { uriScheme :: URI -> String
uriScheme = String
"pb:"
        , uriAuthority :: URI -> Maybe URIAuth
uriAuthority = Just URIAuth{uriUserInfo :: URIAuth -> String
uriUserInfo = String
tubid, uriRegName :: URIAuth -> String
uriRegName = String
host, uriPort :: URIAuth -> String
uriPort = (Char
':' : String
port)}
        , uriPath :: URI -> String
uriPath = (Char
'/' : String
swissnum)
        , uriFragment :: URI -> String
uriFragment = String
"" -- It's a fURL, not a NURL, so there's no fragment.
        } =
        case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
port of
            Maybe Int
Nothing -> Either LookupError StorageServer
-> m (Either LookupError StorageServer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either LookupError StorageServer
 -> m (Either LookupError StorageServer))
-> (String -> Either LookupError StorageServer)
-> String
-> m (Either LookupError StorageServer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LookupError -> Either LookupError StorageServer
forall a b. a -> Either a b
Left (LookupError -> Either LookupError StorageServer)
-> (String -> LookupError)
-> String
-> Either LookupError StorageServer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LookupError
PortParseError (String -> m (Either LookupError StorageServer))
-> String -> m (Either LookupError StorageServer)
forall a b. (a -> b) -> a -> b
$ String
port
            Just Int
realPort -> do
                Manager
manager <- IO Manager -> m Manager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Manager -> m Manager) -> IO Manager -> m Manager
forall a b. (a -> b) -> a -> b
$ String -> String -> IO Manager
forall (m :: * -> *). MonadIO m => String -> String -> m Manager
newGBSManager String
tubid String
swissnum

                Either LookupError StorageServer
-> m (Either LookupError StorageServer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either LookupError StorageServer
 -> m (Either LookupError StorageServer))
-> (StorageServer -> Either LookupError StorageServer)
-> StorageServer
-> m (Either LookupError StorageServer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageServer -> Either LookupError StorageServer
forall a b. b -> Either a b
Right (StorageServer -> m (Either LookupError StorageServer))
-> StorageServer -> m (Either LookupError StorageServer)
forall a b. (a -> b) -> a -> b
$ GetShareNumbers
-> ReadShare -> Manager -> String -> Int -> StorageServer
mkWrapper GetShareNumbers
getShareNumbers ReadShare
readShare Manager
manager String
host Int
realPort
makeServer GetShareNumbers
_ ReadShare
_ URI
_ = Either LookupError StorageServer
-> m (Either LookupError StorageServer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either LookupError StorageServer
 -> m (Either LookupError StorageServer))
-> (LookupError -> Either LookupError StorageServer)
-> LookupError
-> m (Either LookupError StorageServer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LookupError -> Either LookupError StorageServer
forall a b. a -> Either a b
Left (LookupError -> m (Either LookupError StorageServer))
-> LookupError -> m (Either LookupError StorageServer)
forall a b. (a -> b) -> a -> b
$ LookupError
AnnouncementStructureUnmatched

announcementToStorageServer :: MonadIO m => GetShareNumbers -> ReadShare -> StorageServerAnnouncement -> m (Either LookupError StorageServer)
announcementToStorageServer :: GetShareNumbers
-> ReadShare
-> StorageServerAnnouncement
-> m (Either LookupError StorageServer)
announcementToStorageServer GetShareNumbers
getShareNumbers ReadShare
readShare StorageServerAnnouncement
ann =
    case StorageServerAnnouncement -> Maybe URI
greatBlackSwampURIs StorageServerAnnouncement
ann of
        Maybe URI
Nothing -> Either LookupError StorageServer
-> m (Either LookupError StorageServer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either LookupError StorageServer
 -> m (Either LookupError StorageServer))
-> (StorageServerAnnouncement -> Either LookupError StorageServer)
-> StorageServerAnnouncement
-> m (Either LookupError StorageServer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LookupError -> Either LookupError StorageServer
forall a b. a -> Either a b
Left (LookupError -> Either LookupError StorageServer)
-> (StorageServerAnnouncement -> LookupError)
-> StorageServerAnnouncement
-> Either LookupError StorageServer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageServerAnnouncement -> LookupError
URIParseError (StorageServerAnnouncement -> m (Either LookupError StorageServer))
-> StorageServerAnnouncement
-> m (Either LookupError StorageServer)
forall a b. (a -> b) -> a -> b
$ StorageServerAnnouncement
ann
        Just URI
uri -> GetShareNumbers
-> ReadShare -> URI -> m (Either LookupError StorageServer)
forall (m :: * -> *).
MonadIO m =>
GetShareNumbers
-> ReadShare -> URI -> m (Either LookupError StorageServer)
makeServer GetShareNumbers
getShareNumbers ReadShare
readShare URI
uri