{- git-lfs API
 - 
 - https://github.com/git-lfs/git-lfs/blob/master/docs/api
 -
 - Copyright 2019 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

-- | This implementation of the git-lfs API uses http Request and Response,
-- but leaves actually connecting up the http client to the user.
--
-- You'll want to use a Manager that supports https, since the protocol
-- uses http basic auth.
--
-- Some LFS servers, notably Github's, may require a User-Agent header
-- in some of the requests, in order to allow eg, uploads. No such header
-- is added by default, so be sure to add your own.

{-# LANGUAGE DeriveGeneric, FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE LambdaCase #-}

-- Note that some extensions are necessary for reasons outlined in
-- my July 2021 blog post. -- JEH

module Network.GitLFS (
	-- * Transfer requests
	TransferRequest(..),
	TransferRequestOperation(..),
	TransferAdapter(..),
	TransferRequestObject(..),
	startTransferRequest,

	-- * Responses to transfer requests
	TransferResponse(..),
	TransferResponseOperation(..),
	IsTransferResponseOperation,
	DownloadOperation(..),
	UploadOperation(..),
	OperationParams(..),
	ParsedTransferResponse(..),
	parseTransferResponse,

	-- * Making transfers
	downloadOperationRequest,
	uploadOperationRequests,
	ServerSupportsChunks(..),

	-- * Endpoint discovery
	Endpoint,
	guessEndpoint,
	modifyEndpointRequest,
	sshDiscoverEndpointCommand,
	parseSshDiscoverEndpointResponse,

	-- * Errors
	TransferResponseError(..),
	TransferResponseObjectError(..),

	-- * Additional data types
	Url,
	SHA256,
	GitRef(..),
	NumSeconds,
	HTTPHeader,
	HTTPHeaderValue,
) where

import Data.Aeson
import Data.Aeson.Types
import GHC.Generics
import Network.HTTP.Client
import Data.List
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.ByteString.Lazy as L
import qualified Data.CaseInsensitive as CI
import qualified Network.URI as URI

data TransferRequest = TransferRequest
	{ TransferRequest -> TransferRequestOperation
req_operation :: TransferRequestOperation
	, TransferRequest -> [TransferAdapter]
req_transfers :: [TransferAdapter]
	, TransferRequest -> Maybe GitRef
req_ref :: Maybe GitRef
	, TransferRequest -> [TransferRequestObject]
req_objects :: [TransferRequestObject]
	}
	deriving ((forall x. TransferRequest -> Rep TransferRequest x)
-> (forall x. Rep TransferRequest x -> TransferRequest)
-> Generic TransferRequest
forall x. Rep TransferRequest x -> TransferRequest
forall x. TransferRequest -> Rep TransferRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TransferRequest x -> TransferRequest
$cfrom :: forall x. TransferRequest -> Rep TransferRequest x
Generic, Int -> TransferRequest -> ShowS
[TransferRequest] -> ShowS
TransferRequest -> String
(Int -> TransferRequest -> ShowS)
-> (TransferRequest -> String)
-> ([TransferRequest] -> ShowS)
-> Show TransferRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransferRequest] -> ShowS
$cshowList :: [TransferRequest] -> ShowS
show :: TransferRequest -> String
$cshow :: TransferRequest -> String
showsPrec :: Int -> TransferRequest -> ShowS
$cshowsPrec :: Int -> TransferRequest -> ShowS
Show)

instance ToJSON TransferRequest where
	toJSON :: TransferRequest -> Value
toJSON = Options -> TransferRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
transferRequestOptions
	toEncoding :: TransferRequest -> Encoding
toEncoding = Options -> TransferRequest -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
transferRequestOptions

instance FromJSON TransferRequest where
	parseJSON :: Value -> Parser TransferRequest
parseJSON = Options -> Value -> Parser TransferRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
transferRequestOptions

transferRequestOptions :: Options
transferRequestOptions :: Options
transferRequestOptions = Options -> Options
stripFieldPrefix Options
nonNullOptions

data TransferRequestObject = TransferRequestObject
	{ TransferRequestObject -> SHA256
req_oid :: SHA256
	, TransferRequestObject -> Integer
req_size :: Integer
	}
	deriving ((forall x. TransferRequestObject -> Rep TransferRequestObject x)
-> (forall x. Rep TransferRequestObject x -> TransferRequestObject)
-> Generic TransferRequestObject
forall x. Rep TransferRequestObject x -> TransferRequestObject
forall x. TransferRequestObject -> Rep TransferRequestObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TransferRequestObject x -> TransferRequestObject
$cfrom :: forall x. TransferRequestObject -> Rep TransferRequestObject x
Generic, Int -> TransferRequestObject -> ShowS
[TransferRequestObject] -> ShowS
TransferRequestObject -> String
(Int -> TransferRequestObject -> ShowS)
-> (TransferRequestObject -> String)
-> ([TransferRequestObject] -> ShowS)
-> Show TransferRequestObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransferRequestObject] -> ShowS
$cshowList :: [TransferRequestObject] -> ShowS
show :: TransferRequestObject -> String
$cshow :: TransferRequestObject -> String
showsPrec :: Int -> TransferRequestObject -> ShowS
$cshowsPrec :: Int -> TransferRequestObject -> ShowS
Show)

instance ToJSON TransferRequestObject where
	toJSON :: TransferRequestObject -> Value
toJSON = Options -> TransferRequestObject -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
transferRequestObjectOptions
	toEncoding :: TransferRequestObject -> Encoding
toEncoding = Options -> TransferRequestObject -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
transferRequestObjectOptions

instance FromJSON TransferRequestObject where
	parseJSON :: Value -> Parser TransferRequestObject
parseJSON = Options -> Value -> Parser TransferRequestObject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
transferRequestObjectOptions

transferRequestObjectOptions :: Options
transferRequestObjectOptions :: Options
transferRequestObjectOptions = Options -> Options
stripFieldPrefix Options
defaultOptions

data TransferRequestOperation = RequestDownload | RequestUpload
	deriving (Int -> TransferRequestOperation -> ShowS
[TransferRequestOperation] -> ShowS
TransferRequestOperation -> String
(Int -> TransferRequestOperation -> ShowS)
-> (TransferRequestOperation -> String)
-> ([TransferRequestOperation] -> ShowS)
-> Show TransferRequestOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransferRequestOperation] -> ShowS
$cshowList :: [TransferRequestOperation] -> ShowS
show :: TransferRequestOperation -> String
$cshow :: TransferRequestOperation -> String
showsPrec :: Int -> TransferRequestOperation -> ShowS
$cshowsPrec :: Int -> TransferRequestOperation -> ShowS
Show)

instance ToJSON TransferRequestOperation where
	toJSON :: TransferRequestOperation -> Value
toJSON TransferRequestOperation
RequestDownload = Value
"download"
	toJSON TransferRequestOperation
RequestUpload = Value
"upload"

instance FromJSON TransferRequestOperation where
	parseJSON :: Value -> Parser TransferRequestOperation
parseJSON (String SHA256
"download") = TransferRequestOperation -> Parser TransferRequestOperation
forall (f :: * -> *) a. Applicative f => a -> f a
pure TransferRequestOperation
RequestDownload
	parseJSON (String SHA256
"upload") = TransferRequestOperation -> Parser TransferRequestOperation
forall (f :: * -> *) a. Applicative f => a -> f a
pure TransferRequestOperation
RequestUpload
	parseJSON Value
invalid = String -> Value -> Parser TransferRequestOperation
forall a. String -> Value -> Parser a
typeMismatch String
"TransferRequestOperation" Value
invalid

data TransferResponse op = TransferResponse
	{ TransferResponse op -> Maybe TransferAdapter
transfer :: Maybe TransferAdapter
	, TransferResponse op -> [TransferResponseOperation op]
objects :: [TransferResponseOperation op]
	}
	deriving ((forall x. TransferResponse op -> Rep (TransferResponse op) x)
-> (forall x. Rep (TransferResponse op) x -> TransferResponse op)
-> Generic (TransferResponse op)
forall x. Rep (TransferResponse op) x -> TransferResponse op
forall x. TransferResponse op -> Rep (TransferResponse op) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall op x. Rep (TransferResponse op) x -> TransferResponse op
forall op x. TransferResponse op -> Rep (TransferResponse op) x
$cto :: forall op x. Rep (TransferResponse op) x -> TransferResponse op
$cfrom :: forall op x. TransferResponse op -> Rep (TransferResponse op) x
Generic, Int -> TransferResponse op -> ShowS
[TransferResponse op] -> ShowS
TransferResponse op -> String
(Int -> TransferResponse op -> ShowS)
-> (TransferResponse op -> String)
-> ([TransferResponse op] -> ShowS)
-> Show (TransferResponse op)
forall op. Show op => Int -> TransferResponse op -> ShowS
forall op. Show op => [TransferResponse op] -> ShowS
forall op. Show op => TransferResponse op -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransferResponse op] -> ShowS
$cshowList :: forall op. Show op => [TransferResponse op] -> ShowS
show :: TransferResponse op -> String
$cshow :: forall op. Show op => TransferResponse op -> String
showsPrec :: Int -> TransferResponse op -> ShowS
$cshowsPrec :: forall op. Show op => Int -> TransferResponse op -> ShowS
Show)

instance IsTransferResponseOperation op => ToJSON (TransferResponse op) where
	toJSON :: TransferResponse op -> Value
toJSON = Options -> TransferResponse op -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
nonNullOptions
	toEncoding :: TransferResponse op -> Encoding
toEncoding = Options -> TransferResponse op -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
nonNullOptions

instance IsTransferResponseOperation op => FromJSON (TransferResponse op)

-- | This is an error with a TransferRequest as a whole. It's also possible
-- for a TransferRequest to overall succeed, but fail for some
-- objects; such failures use TransferResponseObjectError.
data TransferResponseError = TransferResponseError
	{ TransferResponseError -> SHA256
resperr_message :: T.Text
	, TransferResponseError -> Maybe SHA256
resperr_request_id :: Maybe T.Text
	, TransferResponseError -> Maybe SHA256
resperr_documentation_url :: Maybe Url
	}
	deriving ((forall x. TransferResponseError -> Rep TransferResponseError x)
-> (forall x. Rep TransferResponseError x -> TransferResponseError)
-> Generic TransferResponseError
forall x. Rep TransferResponseError x -> TransferResponseError
forall x. TransferResponseError -> Rep TransferResponseError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TransferResponseError x -> TransferResponseError
$cfrom :: forall x. TransferResponseError -> Rep TransferResponseError x
Generic, Int -> TransferResponseError -> ShowS
[TransferResponseError] -> ShowS
TransferResponseError -> String
(Int -> TransferResponseError -> ShowS)
-> (TransferResponseError -> String)
-> ([TransferResponseError] -> ShowS)
-> Show TransferResponseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransferResponseError] -> ShowS
$cshowList :: [TransferResponseError] -> ShowS
show :: TransferResponseError -> String
$cshow :: TransferResponseError -> String
showsPrec :: Int -> TransferResponseError -> ShowS
$cshowsPrec :: Int -> TransferResponseError -> ShowS
Show)

instance ToJSON TransferResponseError where
	toJSON :: TransferResponseError -> Value
toJSON = Options -> TransferResponseError -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
transferResponseErrorOptions
	toEncoding :: TransferResponseError -> Encoding
toEncoding = Options -> TransferResponseError -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
transferResponseErrorOptions

instance FromJSON TransferResponseError where
	parseJSON :: Value -> Parser TransferResponseError
parseJSON = Options -> Value -> Parser TransferResponseError
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
transferResponseErrorOptions

transferResponseErrorOptions :: Options
transferResponseErrorOptions :: Options
transferResponseErrorOptions = Options -> Options
stripFieldPrefix Options
nonNullOptions

-- | An error with a single object within a TransferRequest.
data TransferResponseObjectError = TransferResponseObjectError
	{ TransferResponseObjectError -> Int
respobjerr_code :: Int
	, TransferResponseObjectError -> SHA256
respobjerr_message :: T.Text
	}
	deriving ((forall x.
 TransferResponseObjectError -> Rep TransferResponseObjectError x)
-> (forall x.
    Rep TransferResponseObjectError x -> TransferResponseObjectError)
-> Generic TransferResponseObjectError
forall x.
Rep TransferResponseObjectError x -> TransferResponseObjectError
forall x.
TransferResponseObjectError -> Rep TransferResponseObjectError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep TransferResponseObjectError x -> TransferResponseObjectError
$cfrom :: forall x.
TransferResponseObjectError -> Rep TransferResponseObjectError x
Generic, Int -> TransferResponseObjectError -> ShowS
[TransferResponseObjectError] -> ShowS
TransferResponseObjectError -> String
(Int -> TransferResponseObjectError -> ShowS)
-> (TransferResponseObjectError -> String)
-> ([TransferResponseObjectError] -> ShowS)
-> Show TransferResponseObjectError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransferResponseObjectError] -> ShowS
$cshowList :: [TransferResponseObjectError] -> ShowS
show :: TransferResponseObjectError -> String
$cshow :: TransferResponseObjectError -> String
showsPrec :: Int -> TransferResponseObjectError -> ShowS
$cshowsPrec :: Int -> TransferResponseObjectError -> ShowS
Show)

instance ToJSON TransferResponseObjectError where
	toJSON :: TransferResponseObjectError -> Value
toJSON = Options -> TransferResponseObjectError -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
transferResponseObjectErrorOptions
	toEncoding :: TransferResponseObjectError -> Encoding
toEncoding = Options -> TransferResponseObjectError -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
transferResponseObjectErrorOptions

instance FromJSON TransferResponseObjectError where
	parseJSON :: Value -> Parser TransferResponseObjectError
parseJSON = Options -> Value -> Parser TransferResponseObjectError
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
transferResponseObjectErrorOptions

transferResponseObjectErrorOptions :: Options
transferResponseObjectErrorOptions :: Options
transferResponseObjectErrorOptions = Options -> Options
stripFieldPrefix Options
nonNullOptions

data TransferAdapter = Basic
	deriving (Int -> TransferAdapter -> ShowS
[TransferAdapter] -> ShowS
TransferAdapter -> String
(Int -> TransferAdapter -> ShowS)
-> (TransferAdapter -> String)
-> ([TransferAdapter] -> ShowS)
-> Show TransferAdapter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransferAdapter] -> ShowS
$cshowList :: [TransferAdapter] -> ShowS
show :: TransferAdapter -> String
$cshow :: TransferAdapter -> String
showsPrec :: Int -> TransferAdapter -> ShowS
$cshowsPrec :: Int -> TransferAdapter -> ShowS
Show)

instance ToJSON TransferAdapter where
	toJSON :: TransferAdapter -> Value
toJSON TransferAdapter
Basic = Value
"basic"

instance FromJSON TransferAdapter where
	parseJSON :: Value -> Parser TransferAdapter
parseJSON (String SHA256
"basic") = TransferAdapter -> Parser TransferAdapter
forall (f :: * -> *) a. Applicative f => a -> f a
pure TransferAdapter
Basic
	parseJSON Value
invalid = String -> Value -> Parser TransferAdapter
forall a. String -> Value -> Parser a
typeMismatch String
"basic" Value
invalid

data TransferResponseOperation op = TransferResponseOperation
	{ TransferResponseOperation op -> SHA256
resp_oid :: SHA256
	, TransferResponseOperation op -> Integer
resp_size :: Integer
	, TransferResponseOperation op -> Maybe Bool
resp_authenticated :: Maybe Bool
	, TransferResponseOperation op -> Maybe op
resp_actions :: Maybe op
	, TransferResponseOperation op -> Maybe TransferResponseObjectError
resp_error :: Maybe TransferResponseObjectError
	}
	deriving ((forall x.
 TransferResponseOperation op
 -> Rep (TransferResponseOperation op) x)
-> (forall x.
    Rep (TransferResponseOperation op) x
    -> TransferResponseOperation op)
-> Generic (TransferResponseOperation op)
forall x.
Rep (TransferResponseOperation op) x
-> TransferResponseOperation op
forall x.
TransferResponseOperation op
-> Rep (TransferResponseOperation op) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall op x.
Rep (TransferResponseOperation op) x
-> TransferResponseOperation op
forall op x.
TransferResponseOperation op
-> Rep (TransferResponseOperation op) x
$cto :: forall op x.
Rep (TransferResponseOperation op) x
-> TransferResponseOperation op
$cfrom :: forall op x.
TransferResponseOperation op
-> Rep (TransferResponseOperation op) x
Generic, Int -> TransferResponseOperation op -> ShowS
[TransferResponseOperation op] -> ShowS
TransferResponseOperation op -> String
(Int -> TransferResponseOperation op -> ShowS)
-> (TransferResponseOperation op -> String)
-> ([TransferResponseOperation op] -> ShowS)
-> Show (TransferResponseOperation op)
forall op. Show op => Int -> TransferResponseOperation op -> ShowS
forall op. Show op => [TransferResponseOperation op] -> ShowS
forall op. Show op => TransferResponseOperation op -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransferResponseOperation op] -> ShowS
$cshowList :: forall op. Show op => [TransferResponseOperation op] -> ShowS
show :: TransferResponseOperation op -> String
$cshow :: forall op. Show op => TransferResponseOperation op -> String
showsPrec :: Int -> TransferResponseOperation op -> ShowS
$cshowsPrec :: forall op. Show op => Int -> TransferResponseOperation op -> ShowS
Show)

instance ToJSON op => ToJSON (TransferResponseOperation op) where
	toJSON :: TransferResponseOperation op -> Value
toJSON = Options -> TransferResponseOperation op -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
transferResponseOperationOptions
	toEncoding :: TransferResponseOperation op -> Encoding
toEncoding = Options -> TransferResponseOperation op -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
transferResponseOperationOptions

instance FromJSON op => FromJSON (TransferResponseOperation op) where
	parseJSON :: Value -> Parser (TransferResponseOperation op)
parseJSON = Options -> Value -> Parser (TransferResponseOperation op)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
transferResponseOperationOptions

transferResponseOperationOptions :: Options
transferResponseOperationOptions :: Options
transferResponseOperationOptions = Options -> Options
stripFieldPrefix Options
nonNullOptions

-- | Class of types that can be responses to a transfer request,
-- that contain an operation to use to make the transfer.
class (FromJSON op, ToJSON op) => IsTransferResponseOperation op

data DownloadOperation = DownloadOperation
	{ DownloadOperation -> OperationParams
download :: OperationParams }
	deriving ((forall x. DownloadOperation -> Rep DownloadOperation x)
-> (forall x. Rep DownloadOperation x -> DownloadOperation)
-> Generic DownloadOperation
forall x. Rep DownloadOperation x -> DownloadOperation
forall x. DownloadOperation -> Rep DownloadOperation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DownloadOperation x -> DownloadOperation
$cfrom :: forall x. DownloadOperation -> Rep DownloadOperation x
Generic, Int -> DownloadOperation -> ShowS
[DownloadOperation] -> ShowS
DownloadOperation -> String
(Int -> DownloadOperation -> ShowS)
-> (DownloadOperation -> String)
-> ([DownloadOperation] -> ShowS)
-> Show DownloadOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DownloadOperation] -> ShowS
$cshowList :: [DownloadOperation] -> ShowS
show :: DownloadOperation -> String
$cshow :: DownloadOperation -> String
showsPrec :: Int -> DownloadOperation -> ShowS
$cshowsPrec :: Int -> DownloadOperation -> ShowS
Show)

instance IsTransferResponseOperation DownloadOperation
instance ToJSON DownloadOperation
instance FromJSON DownloadOperation

data UploadOperation = UploadOperation
	{ UploadOperation -> OperationParams
upload :: OperationParams
	, UploadOperation -> Maybe OperationParams
verify :: Maybe OperationParams
	}
	deriving ((forall x. UploadOperation -> Rep UploadOperation x)
-> (forall x. Rep UploadOperation x -> UploadOperation)
-> Generic UploadOperation
forall x. Rep UploadOperation x -> UploadOperation
forall x. UploadOperation -> Rep UploadOperation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UploadOperation x -> UploadOperation
$cfrom :: forall x. UploadOperation -> Rep UploadOperation x
Generic, Int -> UploadOperation -> ShowS
[UploadOperation] -> ShowS
UploadOperation -> String
(Int -> UploadOperation -> ShowS)
-> (UploadOperation -> String)
-> ([UploadOperation] -> ShowS)
-> Show UploadOperation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UploadOperation] -> ShowS
$cshowList :: [UploadOperation] -> ShowS
show :: UploadOperation -> String
$cshow :: UploadOperation -> String
showsPrec :: Int -> UploadOperation -> ShowS
$cshowsPrec :: Int -> UploadOperation -> ShowS
Show)

instance IsTransferResponseOperation UploadOperation

instance ToJSON UploadOperation where
	toJSON :: UploadOperation -> Value
toJSON = Options -> UploadOperation -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
nonNullOptions
	toEncoding :: UploadOperation -> Encoding
toEncoding = Options -> UploadOperation -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
nonNullOptions

instance FromJSON UploadOperation

data OperationParams = OperationParams
	{ OperationParams -> SHA256
href :: Url
	, OperationParams -> Maybe (Map SHA256 SHA256)
header :: Maybe (M.Map HTTPHeader HTTPHeaderValue)
	, OperationParams -> Maybe Integer
expires_in :: Maybe NumSeconds
	, OperationParams -> Maybe SHA256
expires_at :: Maybe T.Text
	}
	deriving ((forall x. OperationParams -> Rep OperationParams x)
-> (forall x. Rep OperationParams x -> OperationParams)
-> Generic OperationParams
forall x. Rep OperationParams x -> OperationParams
forall x. OperationParams -> Rep OperationParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OperationParams x -> OperationParams
$cfrom :: forall x. OperationParams -> Rep OperationParams x
Generic, Int -> OperationParams -> ShowS
[OperationParams] -> ShowS
OperationParams -> String
(Int -> OperationParams -> ShowS)
-> (OperationParams -> String)
-> ([OperationParams] -> ShowS)
-> Show OperationParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OperationParams] -> ShowS
$cshowList :: [OperationParams] -> ShowS
show :: OperationParams -> String
$cshow :: OperationParams -> String
showsPrec :: Int -> OperationParams -> ShowS
$cshowsPrec :: Int -> OperationParams -> ShowS
Show)

instance ToJSON OperationParams where
	toJSON :: OperationParams -> Value
toJSON = Options -> OperationParams -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
nonNullOptions
	toEncoding :: OperationParams -> Encoding
toEncoding = Options -> OperationParams -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
nonNullOptions

instance FromJSON OperationParams

data Verification = Verification
	{ Verification -> SHA256
verification_oid :: SHA256
	, Verification -> Integer
verification_size :: Integer
	}
	deriving ((forall x. Verification -> Rep Verification x)
-> (forall x. Rep Verification x -> Verification)
-> Generic Verification
forall x. Rep Verification x -> Verification
forall x. Verification -> Rep Verification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Verification x -> Verification
$cfrom :: forall x. Verification -> Rep Verification x
Generic, Int -> Verification -> ShowS
[Verification] -> ShowS
Verification -> String
(Int -> Verification -> ShowS)
-> (Verification -> String)
-> ([Verification] -> ShowS)
-> Show Verification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verification] -> ShowS
$cshowList :: [Verification] -> ShowS
show :: Verification -> String
$cshow :: Verification -> String
showsPrec :: Int -> Verification -> ShowS
$cshowsPrec :: Int -> Verification -> ShowS
Show)

instance ToJSON Verification where
	toJSON :: Verification -> Value
toJSON = Options -> Verification -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
verificationOptions
	toEncoding :: Verification -> Encoding
toEncoding = Options -> Verification -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
verificationOptions

instance FromJSON Verification where
	parseJSON :: Value -> Parser Verification
parseJSON = Options -> Value -> Parser Verification
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
verificationOptions

verificationOptions :: Options
verificationOptions :: Options
verificationOptions = Options -> Options
stripFieldPrefix Options
defaultOptions

-- | Sent over ssh connection when using that to find the endpoint.
data SshDiscoveryResponse = SshDiscoveryResponse
	{ SshDiscoveryResponse -> SHA256
endpoint_href :: Url
	, SshDiscoveryResponse -> Maybe (Map SHA256 SHA256)
endpoint_header :: Maybe (M.Map HTTPHeader HTTPHeaderValue)
	, SshDiscoveryResponse -> Maybe Integer
endpoint_expires_in :: Maybe NumSeconds
	, SshDiscoveryResponse -> Maybe SHA256
endpoint_expires_at :: Maybe T.Text
	} deriving ((forall x. SshDiscoveryResponse -> Rep SshDiscoveryResponse x)
-> (forall x. Rep SshDiscoveryResponse x -> SshDiscoveryResponse)
-> Generic SshDiscoveryResponse
forall x. Rep SshDiscoveryResponse x -> SshDiscoveryResponse
forall x. SshDiscoveryResponse -> Rep SshDiscoveryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SshDiscoveryResponse x -> SshDiscoveryResponse
$cfrom :: forall x. SshDiscoveryResponse -> Rep SshDiscoveryResponse x
Generic, Int -> SshDiscoveryResponse -> ShowS
[SshDiscoveryResponse] -> ShowS
SshDiscoveryResponse -> String
(Int -> SshDiscoveryResponse -> ShowS)
-> (SshDiscoveryResponse -> String)
-> ([SshDiscoveryResponse] -> ShowS)
-> Show SshDiscoveryResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SshDiscoveryResponse] -> ShowS
$cshowList :: [SshDiscoveryResponse] -> ShowS
show :: SshDiscoveryResponse -> String
$cshow :: SshDiscoveryResponse -> String
showsPrec :: Int -> SshDiscoveryResponse -> ShowS
$cshowsPrec :: Int -> SshDiscoveryResponse -> ShowS
Show)

instance ToJSON SshDiscoveryResponse where
	toJSON :: SshDiscoveryResponse -> Value
toJSON = Options -> SshDiscoveryResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
sshDiscoveryResponseOptions
	toEncoding :: SshDiscoveryResponse -> Encoding
toEncoding = Options -> SshDiscoveryResponse -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
sshDiscoveryResponseOptions

instance FromJSON SshDiscoveryResponse where
	parseJSON :: Value -> Parser SshDiscoveryResponse
parseJSON = Options -> Value -> Parser SshDiscoveryResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
sshDiscoveryResponseOptions

sshDiscoveryResponseOptions :: Options
sshDiscoveryResponseOptions :: Options
sshDiscoveryResponseOptions = Options -> Options
stripFieldPrefix Options
nonNullOptions

data GitRef = GitRef
	{ GitRef -> SHA256
name :: T.Text }
	deriving ((forall x. GitRef -> Rep GitRef x)
-> (forall x. Rep GitRef x -> GitRef) -> Generic GitRef
forall x. Rep GitRef x -> GitRef
forall x. GitRef -> Rep GitRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GitRef x -> GitRef
$cfrom :: forall x. GitRef -> Rep GitRef x
Generic, Int -> GitRef -> ShowS
[GitRef] -> ShowS
GitRef -> String
(Int -> GitRef -> ShowS)
-> (GitRef -> String) -> ([GitRef] -> ShowS) -> Show GitRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitRef] -> ShowS
$cshowList :: [GitRef] -> ShowS
show :: GitRef -> String
$cshow :: GitRef -> String
showsPrec :: Int -> GitRef -> ShowS
$cshowsPrec :: Int -> GitRef -> ShowS
Show)

instance FromJSON GitRef
instance ToJSON GitRef

type SHA256 = T.Text

-- | The endpoint of a git-lfs server.
data Endpoint = Endpoint Request
	deriving (Int -> Endpoint -> ShowS
[Endpoint] -> ShowS
Endpoint -> String
(Int -> Endpoint -> ShowS)
-> (Endpoint -> String) -> ([Endpoint] -> ShowS) -> Show Endpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Endpoint] -> ShowS
$cshowList :: [Endpoint] -> ShowS
show :: Endpoint -> String
$cshow :: Endpoint -> String
showsPrec :: Int -> Endpoint -> ShowS
$cshowsPrec :: Int -> Endpoint -> ShowS
Show)

-- | Command to run via ssh with to discover an endpoint. The FilePath is
-- the location of the git repository on the ssh server.
--
-- Note that, when sshing to the server, you should take care that the
-- hostname you pass to ssh is really a hostname and not something that ssh
-- will parse an an option, such as -oProxyCommand=".
sshDiscoverEndpointCommand :: FilePath -> TransferRequestOperation -> [String]
sshDiscoverEndpointCommand :: String -> TransferRequestOperation -> [String]
sshDiscoverEndpointCommand String
remotepath TransferRequestOperation
tro =
	[ String
"git-lfs-authenticate"
	, String
remotepath
	, case TransferRequestOperation
tro of
		TransferRequestOperation
RequestDownload -> String
"download"
		TransferRequestOperation
RequestUpload -> String
"upload"
	]

-- Internal smart constructor for an Endpoint.
-- 
-- Since this uses the LFS batch API, it adds /objects/batch
-- to the endpoint url. It also adds the necessary headers to use JSON.
mkEndpoint :: URI.URI -> Maybe Endpoint
mkEndpoint :: URI -> Maybe Endpoint
mkEndpoint URI
uri = do
	Request
r <- URI -> Maybe Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
requestFromURI URI
uri
	let r' :: Request
r' = Request -> Request
addLfsJsonHeaders (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
r { path :: ByteString
path = Request -> ByteString
path Request
r ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/objects/batch" }
	Endpoint -> Maybe Endpoint
forall (m :: * -> *) a. Monad m => a -> m a
return (Request -> Endpoint
Endpoint Request
r')

-- | Parse the json output when doing ssh endpoint discovery.
parseSshDiscoverEndpointResponse :: L.ByteString -> Maybe Endpoint
parseSshDiscoverEndpointResponse :: ByteString -> Maybe Endpoint
parseSshDiscoverEndpointResponse ByteString
resp = do
	SshDiscoveryResponse
sr <- ByteString -> Maybe SshDiscoveryResponse
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
resp
	URI
uri <- String -> Maybe URI
URI.parseURI (SHA256 -> String
T.unpack (SshDiscoveryResponse -> SHA256
endpoint_href SshDiscoveryResponse
sr))
	Endpoint
endpoint <- URI -> Maybe Endpoint
mkEndpoint URI
uri
	Endpoint -> Maybe Endpoint
forall (m :: * -> *) a. Monad m => a -> m a
return (Endpoint -> Maybe Endpoint) -> Endpoint -> Maybe Endpoint
forall a b. (a -> b) -> a -> b
$ Endpoint -> (Request -> Request) -> Endpoint
modifyEndpointRequest Endpoint
endpoint ((Request -> Request) -> Endpoint)
-> (Request -> Request) -> Endpoint
forall a b. (a -> b) -> a -> b
$ case SshDiscoveryResponse -> Maybe (Map SHA256 SHA256)
endpoint_header SshDiscoveryResponse
sr of
		Maybe (Map SHA256 SHA256)
Nothing -> Request -> Request
forall a. a -> a
id
		Just Map SHA256 SHA256
headers ->
			let headers' :: [(CI ByteString, ByteString)]
headers' = ((SHA256, SHA256) -> (CI ByteString, ByteString))
-> [(SHA256, SHA256)] -> [(CI ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (SHA256, SHA256) -> (CI ByteString, ByteString)
convheader (Map SHA256 SHA256 -> [(SHA256, SHA256)]
forall k a. Map k a -> [(k, a)]
M.toList Map SHA256 SHA256
headers)
			in \Request
req -> Request
req
				{ requestHeaders :: [(CI ByteString, ByteString)]
requestHeaders = Request -> [(CI ByteString, ByteString)]
requestHeaders Request
req [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall a. [a] -> [a] -> [a]
++ [(CI ByteString, ByteString)]
headers' }
  where
	convheader :: (SHA256, SHA256) -> (CI ByteString, ByteString)
convheader (SHA256
k, SHA256
v) = (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (SHA256 -> ByteString
E.encodeUtf8 SHA256
k), SHA256 -> ByteString
E.encodeUtf8 SHA256
v)

-- | Guesses the LFS endpoint from the http url of a git remote.
--
-- https://github.com/git-lfs/git-lfs/blob/master/docs/api/server-discovery.md
guessEndpoint :: URI.URI -> Maybe Endpoint
guessEndpoint :: URI -> Maybe Endpoint
guessEndpoint URI
uri = case URI -> String
URI.uriScheme URI
uri of
	String
"https:" -> Maybe Endpoint
endpoint
	String
"http:" -> Maybe Endpoint
endpoint
	String
_ -> Maybe Endpoint
forall a. Maybe a
Nothing
  where
	endpoint :: Maybe Endpoint
endpoint = URI -> Maybe Endpoint
mkEndpoint (URI -> Maybe Endpoint) -> URI -> Maybe Endpoint
forall a b. (a -> b) -> a -> b
$ URI
uri
		-- force https because the git-lfs protocol uses http
		-- basic auth tokens, which should not be exposed
		{ uriScheme :: String
URI.uriScheme = String
"https:"
		, uriPath :: String
URI.uriPath = String
guessedpath
		}
	
	guessedpath :: String
guessedpath
		| String
".git" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` URI -> String
URI.uriPath URI
uri =
			URI -> String
URI.uriPath URI
uri String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/info/lfs"
		| String
".git/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` URI -> String
URI.uriPath URI
uri =
			URI -> String
URI.uriPath URI
uri String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"info/lfs"
		| Bool
otherwise = (Char -> ShowS
forall a. Eq a => a -> [a] -> [a]
droptrailing Char
'/' (URI -> String
URI.uriPath URI
uri)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".git/info/lfs"
	
	droptrailing :: a -> [a] -> [a]
droptrailing a
c = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse

-- | When an Endpoint is used to generate a Request, this allows adjusting
-- that Request.
--
-- This can be used to add http basic authentication to an Endpoint:
--
-- > modifyEndpointRequest (guessEndpoint u) (applyBasicAuth "user" "pass")
modifyEndpointRequest :: Endpoint -> (Request -> Request) -> Endpoint
modifyEndpointRequest :: Endpoint -> (Request -> Request) -> Endpoint
modifyEndpointRequest (Endpoint Request
r) Request -> Request
f = Request -> Endpoint
Endpoint (Request -> Request
f Request
r)

-- | Makes a Request that will start the process of making a transfer to or
-- from the LFS endpoint.
startTransferRequest :: Endpoint -> TransferRequest -> Request
startTransferRequest :: Endpoint -> TransferRequest -> Request
startTransferRequest (Endpoint Request
r) TransferRequest
tr = Request
r
	{ method :: ByteString
method = ByteString
"POST"
	, requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS (TransferRequest -> ByteString
forall a. ToJSON a => a -> ByteString
encode TransferRequest
tr)
	}

addLfsJsonHeaders :: Request -> Request
addLfsJsonHeaders :: Request -> Request
addLfsJsonHeaders Request
r = Request
r
	{ requestHeaders :: [(CI ByteString, ByteString)]
requestHeaders = Request -> [(CI ByteString, ByteString)]
requestHeaders Request
r [(CI ByteString, ByteString)]
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall a. [a] -> [a] -> [a]
++
		[ (CI ByteString
"Accept", ByteString
lfsjson)
		, (CI ByteString
"Content-Type", ByteString
lfsjson)
		]
	}
  where
	lfsjson :: ByteString
lfsjson = ByteString
"application/vnd.git-lfs+json"

data ParsedTransferResponse op
	= ParsedTransferResponse (TransferResponse op)
	| ParsedTransferResponseError TransferResponseError
	| ParseFailed String

-- | Parse the body of a response to a transfer request.
parseTransferResponse
	:: IsTransferResponseOperation op
	=> L.ByteString
	-> ParsedTransferResponse op
parseTransferResponse :: ByteString -> ParsedTransferResponse op
parseTransferResponse ByteString
resp = case ByteString -> Either String (TransferResponse op)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
resp of
	Right TransferResponse op
tr -> TransferResponse op -> ParsedTransferResponse op
forall op. TransferResponse op -> ParsedTransferResponse op
ParsedTransferResponse TransferResponse op
tr
	-- If unable to decode as a TransferResponse, try to decode
	-- as a TransferResponseError instead, in case the LFS server
	-- sent an error message.
	Left String
err ->
		(String -> ParsedTransferResponse op)
-> (TransferResponseError -> ParsedTransferResponse op)
-> Either String TransferResponseError
-> ParsedTransferResponse op
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParsedTransferResponse op -> String -> ParsedTransferResponse op
forall a b. a -> b -> a
const (ParsedTransferResponse op -> String -> ParsedTransferResponse op)
-> ParsedTransferResponse op -> String -> ParsedTransferResponse op
forall a b. (a -> b) -> a -> b
$ String -> ParsedTransferResponse op
forall op. String -> ParsedTransferResponse op
ParseFailed String
err) TransferResponseError -> ParsedTransferResponse op
forall op. TransferResponseError -> ParsedTransferResponse op
ParsedTransferResponseError (Either String TransferResponseError -> ParsedTransferResponse op)
-> Either String TransferResponseError -> ParsedTransferResponse op
forall a b. (a -> b) -> a -> b
$
			ByteString -> Either String TransferResponseError
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
resp

-- | Builds a http request to perform a download.
downloadOperationRequest :: DownloadOperation -> Maybe Request
downloadOperationRequest :: DownloadOperation -> Maybe Request
downloadOperationRequest = ((Request, ServerSupportsChunks) -> Request)
-> Maybe (Request, ServerSupportsChunks) -> Maybe Request
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Request, ServerSupportsChunks) -> Request
forall a b. (a, b) -> a
fst (Maybe (Request, ServerSupportsChunks) -> Maybe Request)
-> (DownloadOperation -> Maybe (Request, ServerSupportsChunks))
-> DownloadOperation
-> Maybe Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OperationParams -> Maybe (Request, ServerSupportsChunks)
operationParamsRequest (OperationParams -> Maybe (Request, ServerSupportsChunks))
-> (DownloadOperation -> OperationParams)
-> DownloadOperation
-> Maybe (Request, ServerSupportsChunks)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DownloadOperation -> OperationParams
download

-- | Builds http request to perform an upload. The content to upload is
-- provided, along with its SHA256 and size.
--
-- When the LFS server requested verification, there will be a second
-- Request that does that; it should be run only after the upload has
-- succeeded.
--
-- When the LFS server already contains the object, an empty list may be
-- returned.
uploadOperationRequests :: UploadOperation -> (ServerSupportsChunks -> RequestBody) -> SHA256 -> Integer -> Maybe [Request]
uploadOperationRequests :: UploadOperation
-> (ServerSupportsChunks -> RequestBody)
-> SHA256
-> Integer
-> Maybe [Request]
uploadOperationRequests UploadOperation
op ServerSupportsChunks -> RequestBody
mkcontent SHA256
oid Integer
size = 
	case (Maybe Request
mkdlreq, Maybe Request
mkverifyreq) of
		(Maybe Request
Nothing, Maybe Request
_) -> Maybe [Request] -> Maybe [Request]
forall a. a -> a
check Maybe [Request]
forall a. Maybe a
Nothing
		(Just Request
dlreq, Maybe Request
Nothing) -> Maybe [Request] -> Maybe [Request]
forall a. a -> a
check (Maybe [Request] -> Maybe [Request])
-> Maybe [Request] -> Maybe [Request]
forall a b. (a -> b) -> a -> b
$ [Request] -> Maybe [Request]
forall a. a -> Maybe a
Just [Request
dlreq]
		(Just Request
dlreq, Just Request
verifyreq) -> Maybe [Request] -> Maybe [Request]
forall a. a -> a
check (Maybe [Request] -> Maybe [Request])
-> Maybe [Request] -> Maybe [Request]
forall a b. (a -> b) -> a -> b
$ [Request] -> Maybe [Request]
forall a. a -> Maybe a
Just [Request
dlreq, Request
verifyreq]
  where
	check :: p -> p
check p
a
		| Integer -> String
forall a. Show a => a -> String
show Integer
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> String
forall a. Show a => a -> String
show Integer
b12 = p -> p
check p
a
		| Bool
otherwise = p
a
	  where
		b12 :: Integer
		b12 :: Integer
b12 = Integer
1
		x :: Integer
		x :: Integer
x = Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)Integer
0b1Integer
2

	mkdlreq :: Maybe Request
mkdlreq = (Request, ServerSupportsChunks) -> Request
mkdlreq'
		((Request, ServerSupportsChunks) -> Request)
-> Maybe (Request, ServerSupportsChunks) -> Maybe Request
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OperationParams -> Maybe (Request, ServerSupportsChunks)
operationParamsRequest (UploadOperation -> OperationParams
upload UploadOperation
op)
	mkdlreq' :: (Request, ServerSupportsChunks) -> Request
mkdlreq' (Request
r, ServerSupportsChunks
ssc) = Request
r
		{ method :: ByteString
method = ByteString
"PUT"
		, requestBody :: RequestBody
requestBody = ServerSupportsChunks -> RequestBody
mkcontent ServerSupportsChunks
ssc
		}
	mkverifyreq :: Maybe Request
mkverifyreq = (Request, ServerSupportsChunks) -> Request
forall b. (Request, b) -> Request
mkverifyreq'
		((Request, ServerSupportsChunks) -> Request)
-> Maybe (Request, ServerSupportsChunks) -> Maybe Request
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (OperationParams -> Maybe (Request, ServerSupportsChunks)
operationParamsRequest (OperationParams -> Maybe (Request, ServerSupportsChunks))
-> Maybe OperationParams -> Maybe (Request, ServerSupportsChunks)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UploadOperation -> Maybe OperationParams
verify UploadOperation
op)
	mkverifyreq' :: (Request, b) -> Request
mkverifyreq' (Request
r, b
_ssc) = Request -> Request
addLfsJsonHeaders (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
r
		{ method :: ByteString
method = ByteString
"POST"
		, requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ Verification -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Verification -> ByteString) -> Verification -> ByteString
forall a b. (a -> b) -> a -> b
$
			SHA256 -> Integer -> Verification
Verification SHA256
oid Integer
size
		}

-- | When the LFS server indicates that it supports Transfer-Encoding chunked,
-- this will contain a true value, and the RequestBody provided to
-- uploadOperationRequests may be created using RequestBodyStreamChunked.
-- Otherwise, that should be avoided as the server may not support the
-- chunked encoding.
newtype ServerSupportsChunks = ServerSupportsChunks Bool

operationParamsRequest :: OperationParams -> Maybe (Request, ServerSupportsChunks)
operationParamsRequest :: OperationParams -> Maybe (Request, ServerSupportsChunks)
operationParamsRequest OperationParams
ps = do
	Request
r <- String -> Maybe Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (SHA256 -> String
T.unpack (OperationParams -> SHA256
href OperationParams
ps))
	let headers :: [(CI ByteString, ByteString)]
headers = ((SHA256, SHA256) -> (CI ByteString, ByteString))
-> [(SHA256, SHA256)] -> [(CI ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (SHA256, SHA256) -> (CI ByteString, ByteString)
convheader ([(SHA256, SHA256)] -> [(CI ByteString, ByteString)])
-> [(SHA256, SHA256)] -> [(CI ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ [(SHA256, SHA256)]
-> (Map SHA256 SHA256 -> [(SHA256, SHA256)])
-> Maybe (Map SHA256 SHA256)
-> [(SHA256, SHA256)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Map SHA256 SHA256 -> [(SHA256, SHA256)]
forall k a. Map k a -> [(k, a)]
M.toList (OperationParams -> Maybe (Map SHA256 SHA256)
header OperationParams
ps)
	let headers' :: [(CI ByteString, ByteString)]
headers' = ((CI ByteString, ByteString) -> Bool)
-> [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter (CI ByteString, ByteString) -> Bool
forall a b. (Eq a, IsString a) => (a, b) -> Bool
allowedheader [(CI ByteString, ByteString)]
headers
	let ssc :: ServerSupportsChunks
ssc = Bool -> ServerSupportsChunks
ServerSupportsChunks (Bool -> ServerSupportsChunks) -> Bool -> ServerSupportsChunks
forall a b. (a -> b) -> a -> b
$
		((CI ByteString, ByteString) -> Bool)
-> [(CI ByteString, ByteString)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((CI ByteString, ByteString) -> (CI ByteString, ByteString) -> Bool
forall a. Eq a => a -> a -> Bool
== (CI ByteString
"Transfer-Encoding", ByteString
"chunked")) [(CI ByteString, ByteString)]
headers
	(Request, ServerSupportsChunks)
-> Maybe (Request, ServerSupportsChunks)
forall (m :: * -> *) a. Monad m => a -> m a
return (Request
r { requestHeaders :: [(CI ByteString, ByteString)]
requestHeaders = [(CI ByteString, ByteString)]
headers' }, ServerSupportsChunks
ssc)
  where
	convheader :: (SHA256, SHA256) -> (CI ByteString, ByteString)
convheader (SHA256
k, SHA256
v) = (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (SHA256 -> ByteString
E.encodeUtf8 SHA256
k), SHA256 -> ByteString
E.encodeUtf8 SHA256
v)
	-- requestHeaders is not allowed to set Transfer-Encoding or 
	-- Content-Length; copying those over blindly could request in a
	-- malformed request.
	allowedheader :: (a, b) -> Bool
allowedheader (a
k, b
_) = a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
"Transfer-Encoding"
		Bool -> Bool -> Bool
&& a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
"Content-Length"

type Url = T.Text

type NumSeconds = Integer

type HTTPHeader = T.Text

type HTTPHeaderValue = T.Text

-- Prevent Nothing from serializing to null.
nonNullOptions :: Options
nonNullOptions :: Options
nonNullOptions = Options
defaultOptions { omitNothingFields :: Bool
omitNothingFields = Bool
True }

-- Remove prefix from field names.
stripFieldPrefix :: Options -> Options
stripFieldPrefix :: Options -> Options
stripFieldPrefix Options
o =
	Options
o { fieldLabelModifier :: ShowS
fieldLabelModifier = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_') }