{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE PackageImports #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
module TahoeLAFS.Storage.Client (
version,
renewLease,
createImmutableStorageIndex,
writeImmutableShare,
abortImmutableUpload,
readImmutableShare,
getImmutableShareNumbers,
adviseCorruptImmutableShare,
readTestWrite,
readMutableShares,
getMutableShareNumbers,
adviseCorruptMutableShare,
parseNURL,
runGBS,
NURL (..),
) where
import Control.Monad ((>=>))
import qualified "base64" Data.ByteString.Base64.URL as Base64URL
import Data.Proxy (Proxy (..))
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Network.HTTP.Client.TLS (
newTlsManagerWith,
)
import Network.Socket (HostName, PortNumber)
import Network.URI (
URIAuth (URIAuth, uriPort, uriRegName, uriUserInfo),
parseURI,
)
import Servant (
URI (URI, uriAuthority, uriFragment, uriPath),
type (:<|>) ((:<|>)),
)
import Servant.Client (
BaseUrl (BaseUrl),
ClientError,
ClientM,
Scheme (Https),
client,
mkClientEnv,
runClientM,
)
import TahoeLAFS.Internal.Client (SPKIHash (SPKIHash), mkGBSManagerSettings)
import TahoeLAFS.Storage.API (
StorageAPI,
)
import Text.Read (readMaybe)
newApi :: Proxy StorageAPI
newApi :: Proxy StorageAPI
newApi = Proxy StorageAPI
forall k (t :: k). Proxy t
Proxy
( ClientM Version
version
:<|> [Char] -> Maybe [LeaseSecret] -> ClientM ()
renewLease
:<|> [Char]
-> Maybe [LeaseSecret]
-> AllocateBuckets
-> ClientM AllocationResult
createImmutableStorageIndex
:<|> [Char]
-> ShareNumber
-> Maybe [LeaseSecret]
-> ByteString
-> Maybe [ByteRange]
-> ClientM ()
writeImmutableShare
:<|> [Char] -> ShareNumber -> Maybe [LeaseSecret] -> ClientM ()
abortImmutableUpload
:<|> [Char] -> ShareNumber -> Maybe [ByteRange] -> ClientM ByteString
readImmutableShare
:<|> [Char] -> ClientM (CBORSet ShareNumber)
getImmutableShareNumbers
:<|> [Char] -> ShareNumber -> CorruptionDetails -> ClientM ()
adviseCorruptImmutableShare
:<|> [Char]
-> Maybe [LeaseSecret]
-> ReadTestWriteVectors
-> ClientM ReadTestWriteResult
readTestWrite
:<|> [Char] -> ShareNumber -> Maybe [ByteRange] -> ClientM ByteString
readMutableShares
:<|> [Char] -> ClientM (CBORSet ShareNumber)
getMutableShareNumbers
:<|> [Char] -> ShareNumber -> CorruptionDetails -> ClientM ()
adviseCorruptMutableShare
) = Proxy StorageAPI -> Client ClientM StorageAPI
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client Proxy StorageAPI
newApi
data NURL = NURLv1
{
NURL -> SPKIHash
nurlv1Fingerprint :: SPKIHash
,
NURL -> ([Char], PortNumber)
nurlv1Address :: (HostName, PortNumber)
,
NURL -> Text
nurlv1Swissnum :: T.Text
}
deriving (Eq NURL
Eq NURL
-> (NURL -> NURL -> Ordering)
-> (NURL -> NURL -> Bool)
-> (NURL -> NURL -> Bool)
-> (NURL -> NURL -> Bool)
-> (NURL -> NURL -> Bool)
-> (NURL -> NURL -> NURL)
-> (NURL -> NURL -> NURL)
-> Ord NURL
NURL -> NURL -> Bool
NURL -> NURL -> Ordering
NURL -> NURL -> NURL
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 :: NURL -> NURL -> NURL
$cmin :: NURL -> NURL -> NURL
max :: NURL -> NURL -> NURL
$cmax :: NURL -> NURL -> NURL
>= :: NURL -> NURL -> Bool
$c>= :: NURL -> NURL -> Bool
> :: NURL -> NURL -> Bool
$c> :: NURL -> NURL -> Bool
<= :: NURL -> NURL -> Bool
$c<= :: NURL -> NURL -> Bool
< :: NURL -> NURL -> Bool
$c< :: NURL -> NURL -> Bool
compare :: NURL -> NURL -> Ordering
$ccompare :: NURL -> NURL -> Ordering
$cp1Ord :: Eq NURL
Ord, NURL -> NURL -> Bool
(NURL -> NURL -> Bool) -> (NURL -> NURL -> Bool) -> Eq NURL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NURL -> NURL -> Bool
$c/= :: NURL -> NURL -> Bool
== :: NURL -> NURL -> Bool
$c== :: NURL -> NURL -> Bool
Eq, Int -> NURL -> ShowS
[NURL] -> ShowS
NURL -> [Char]
(Int -> NURL -> ShowS)
-> (NURL -> [Char]) -> ([NURL] -> ShowS) -> Show NURL
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [NURL] -> ShowS
$cshowList :: [NURL] -> ShowS
show :: NURL -> [Char]
$cshow :: NURL -> [Char]
showsPrec :: Int -> NURL -> ShowS
$cshowsPrec :: Int -> NURL -> ShowS
Show)
parseNURL :: T.Text -> Maybe NURL
parseNURL :: Text -> Maybe NURL
parseNURL = [Char] -> Maybe URI
parseURI ([Char] -> Maybe URI) -> (Text -> [Char]) -> Text -> Maybe URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> Maybe URI) -> (URI -> Maybe NURL) -> Text -> Maybe NURL
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> URI -> Maybe NURL
uriToNURL
uriToNURL :: URI -> Maybe NURL
uriToNURL :: URI -> Maybe NURL
uriToNURL URI{uriAuthority :: URI -> Maybe URIAuth
uriAuthority = Just URIAuth{[Char]
uriUserInfo :: [Char]
uriUserInfo :: URIAuth -> [Char]
uriUserInfo, uriRegName :: URIAuth -> [Char]
uriRegName = [Char]
hostname, uriPort :: URIAuth -> [Char]
uriPort = (Char
':' : [Char]
port)}, uriPath :: URI -> [Char]
uriPath = (Char
'/' : [Char]
swissnum), uriFragment :: URI -> [Char]
uriFragment = [Char]
"#v=1"} =
case (Either Text SPKIHash
requiredHashE, Maybe PortNumber
portM) of
(Left Text
_, Maybe PortNumber
_) -> Maybe NURL
forall a. Maybe a
Nothing
(Either Text SPKIHash
_, Maybe PortNumber
Nothing) -> Maybe NURL
forall a. Maybe a
Nothing
(Right SPKIHash
requiredHash, Just PortNumber
portNum) -> NURL -> Maybe NURL
forall a. a -> Maybe a
Just NURLv1 :: SPKIHash -> ([Char], PortNumber) -> Text -> NURL
NURLv1{nurlv1Fingerprint :: SPKIHash
nurlv1Fingerprint = SPKIHash
requiredHash, nurlv1Address :: ([Char], PortNumber)
nurlv1Address = ([Char]
hostname, PortNumber
portNum), nurlv1Swissnum :: Text
nurlv1Swissnum = [Char] -> Text
T.pack [Char]
swissnum}
where
requiredHashE :: Either Text SPKIHash
requiredHashE = (ByteString -> SPKIHash)
-> Either Text ByteString -> Either Text SPKIHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> SPKIHash
SPKIHash (Either Text ByteString -> Either Text SPKIHash)
-> ([Char] -> Either Text ByteString)
-> [Char]
-> Either Text SPKIHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text ByteString
Base64URL.decodeBase64 (ByteString -> Either Text ByteString)
-> ([Char] -> ByteString) -> [Char] -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> ([Char] -> Text) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> ShowS -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
dropLast Int
1 ([Char] -> Either Text SPKIHash) -> [Char] -> Either Text SPKIHash
forall a b. (a -> b) -> a -> b
$ [Char]
uriUserInfo
portM :: Maybe PortNumber
portM = [Char] -> Maybe PortNumber
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
port
uriToNURL URI
_ = Maybe NURL
forall a. Maybe a
Nothing
runGBS :: NURL -> ClientM a -> IO (Either ClientError a)
runGBS :: NURL -> ClientM a -> IO (Either ClientError a)
runGBS NURLv1{SPKIHash
nurlv1Fingerprint :: SPKIHash
nurlv1Fingerprint :: NURL -> SPKIHash
nurlv1Fingerprint, nurlv1Address :: NURL -> ([Char], PortNumber)
nurlv1Address = ([Char]
hostname, PortNumber
port), Text
nurlv1Swissnum :: Text
nurlv1Swissnum :: NURL -> Text
nurlv1Swissnum} ClientM a
action = do
Manager
manager <- ManagerSettings -> IO Manager
forall (m :: * -> *). MonadIO m => ManagerSettings -> m Manager
newTlsManagerWith (SPKIHash -> Text -> ManagerSettings
mkGBSManagerSettings SPKIHash
nurlv1Fingerprint Text
nurlv1Swissnum)
let clientEnv :: ClientEnv
clientEnv = Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
manager (Scheme -> [Char] -> Int -> [Char] -> BaseUrl
BaseUrl Scheme
Https [Char]
hostname (PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
port) [Char]
"")
ClientM a -> ClientEnv -> IO (Either ClientError a)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM a
action ClientEnv
clientEnv
dropLast :: Int -> [a] -> [a]
dropLast :: Int -> [a] -> [a]
dropLast Int
n [a]
xs =
Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) [a]
xs