category:'SCM-Monticello-RemoteRepositories'

!MCHttpRepository class methodsFor:'documentation'!

documentation

"

    I am general http repository for monticello.

    I support the general protocol for listing files in a remote repository.

"

! !

basicFromUrl: aZnUrl

	^ aZnUrl hasUsername

		ifFalse: [ self location: aZnUrl location ]

		ifTrue: [ (self repositoryClassFor: aZnUrl location) new

				location: aZnUrl location;

				user: aZnUrl username;

				password: aZnUrl password;

				yourself  ]

!

location: location

	^ MCServerRegistry uniqueInstance 

		repositoryAt: location credentialsDo: [ :username :password |

			(self repositoryClassFor: location) new

				location: location;

				user: username;

				password: password;

				yourself ]

!

!

pharoInboxRepository

	^ self location: 'http://smalltalkhub.com/mc/Pharo/Pharo60Inbox/main'.

!

pharoRepository

	^ self location: 'http://smalltalkhub.com/mc/Pharo/Pharo60/main'.

!

project: aProjectIdentifier

	^ self location: self baseURL, aProjectIdentifier

!

repositoryClassFor: location

	MCHttpRepository subclassesDo: [ :subclass | 

		(subclass isResponsibleFor: location)

			ifTrue: [ ^ subclass ]].

	^ MCHttpRepository

! !

!MCHttpRepository class methodsFor:'*Komitter-Models'!

pharoLocations

	"Answer the locations for both pharo and pharo inbox repositories.

	No commit should actually be pushed directly there"

	^ #('http://smalltalkhub.com/mc/Pharo/Pharo60/main' 

		'http://smalltalkhub.com/mc/Pharo/Pharo60/main/' 

		'http://smalltalkhub.com/mc/Pharo/Pharo60Inbox/main'

		'http://smalltalkhub.com/mc/Pharo/Pharo60Inbox/main/'

		'http://smalltalkhub.com/mc/Pharo/Pharo50Inbox/main'

		'http://smalltalkhub.com/mc/Pharo/Pharo50Inbox/main/')

! !

!MCHttpRepository class methodsFor:'*MonticelloGUI'!

fillInTheBlankRequest

	^ 'HTTP Repository:'

!

morphicConfigure

	^ self fillInTheBlankConfigure

! !

!MCHttpRepository class methodsFor:'accessing'!

baseURL

	^ ''

!

urlSchemes

	^ #(http https)

self name,'

    "Modified: / 26-08-2018 / 14:28:47 / Claus Gittinger"

!MCHttpRepository class methodsFor:'testing'!

isResponsibleFor: aURLString

	"Override in subclasses to enable custom instances for certain URLs"

	^ true

! !

!MCHttpRepository methodsFor:'*Komitter-Models'!

isPrivatePharoRepository

	^ self class pharoLocations includes: self location

!

isRemote

	^ self isPrivatePharoRepository not

!

koRemote

	^ KomitHttpRemote new

		remote: self;

		yourself

! !

!MCHttpRepository methodsFor:'*metacello-mc'!

asRepositorySpecFor: aMetacelloMCProject

	^(aMetacelloMCProject repositorySpec)

		description:  self description;

	 	type: 'http';

		yourself

! !

credentials

	^ MCServerCredentials user: self user password: self password

!

credentials: mcServerCredentials

	self user: mcServerCredentials username.

	self password: mcServerCredentials password.

!

        self user isEmpty ifTrue: [^password ? ''].

    "Modified: / 26-08-2018 / 12:37:33 / Claus Gittinger"

project

	"Return a project name"

	^ (self location splitOn: $/) last

!

!MCHttpRepository methodsFor:'actions'!

			names add: fullName urlDecoded ]].

retryOnCredentialRequest: aBlock

	aBlock	on: MCPermissionDenied do: [ :error | |credentials| 

		credentials := MCCredentialsRequest 

							signalUrl: self location

							username: self user

							password: self password.

		credentials 

			ifNotNil: [ 

				self credentials: credentials.

				^ self retryOnCredentialRequest: aBlock ]]

!

urlForFileNamed: aString

	^ self locationWithTrailingSlash, aString urlEncoded

! !

!MCHttpRepository methodsFor:'as yet unclassified'!

asCreationTemplate

	^self class creationTemplateLocation: location user: user password: password

!

!MCHttpRepository methodsFor:'i/o'!

cacheRawVersionNamed: aString stream: contents

	"directly forward the contents to the cache repository. 

	this avoids and unnecessary serialization step"

	MCCacheRepository uniqueInstance 

		writeStreamForFileNamed: aString 

		replace: true 

		do: [ :s| s nextPutAll: contents ]

!

displayProgress: label during: workBlock

	| nextUpdateTime |

	nextUpdateTime := 0.

	^UIManager default displayProgress: label 

		from: 0.0 to: 1.0 during:[:bar|

			[workBlock value] on: HTTPProgress do:[:ex|

				(ex total == nil or: [ex amount == nil]) ifFalse:[

					(nextUpdateTime < Time millisecondClockValue 

						or:[ex total = ex amount]) ifTrue:[

							bar current: ex amount asFloat / ex total asFloat.

							nextUpdateTime := Time millisecondClockValue + 100.

					].

				].

				ex resume.

			]

		].

!

handleUnsuccessfulResponse: aZnResponse

	(#(403 401) includes: aZnResponse code)

		ifTrue: [ MCPermissionDenied signalFor: self ].

	Error signal: 'Could not save version.'

!

loadAllFileNames

	| client |

	self displayProgress: 'Loading all file names from ', self description during: [

		client := self httpClient.

		client

			ifFail: [ :exception | 

				(exception className beginsWith: 'Zn')

					ifTrue: [ MCRepositoryError signal: 'Could not access ', self location, ': ', exception printString ]

					ifFalse: [ exception pass ] ];

			url: self locationWithTrailingSlash;

			queryAt: 'C' put: 'M;O=D';	"legacy that some servers maybe expect"

			get.

		self assertNonBinaryResponse: client response ].

	^ self parseFileNamesFromStream: client contents readStream

! !

!MCHttpRepository methodsFor:'private'!

assertBinaryResponse: response 

	response contentType isBinary ifFalse: [ 

		MCRepositoryError signal: 'Expected a binary response instead of ', response contentType printString ].

!

assertNonBinaryResponse: response 

	response contentType isBinary ifTrue: [ MCRepositoryError signal: 'Did not expect a binary response but got ', response contentType printString ].

!

entityStreamContents: aBlock

	"Generate output in a buffer because we need the length"

	| stream |

	stream := RWBinaryOrTextStream on: String new.

	aBlock value: stream.

	stream reset.

	^ (ZnStreamingEntity type: ZnMimeType applicationOctetStream)

		stream: stream;

		contentLength: stream size;

		yourself

!

httpClient

	"Return a new, specifically configured instance of the HTTP client for internal use.

	Note how we request GZIP compression and will signal progress."

	^ ZnClient new

		systemPolicy;

		beOneShot;

		username: self user password: self password;

		signalProgress: true;

		yourself

        ifTrue: [

            "/ self assertBinaryResponse: client response.

            "immediately cache the version and avoid an unnecessary serialization"

            "/ self cacheRawVersionNamed: aString stream: client contents ].

            aBlock value: response data readStream.

        ].

    "Modified (format): / 26-08-2018 / 14:17:03 / Claus Gittinger"

!MCHttpRepository methodsFor:'storing'!

storeVersion: aVersion

	self retryOnCredentialRequest: [ super storeVersion: aVersion ]

! !