Do you have the code somewhere loadable? Reading chunk is something I do only when everything crashed :D Esteban A. Maringolo
2017-08-14 13:44 GMT-03:00 Herby Vojčík <[email protected]>: > Hello! > > I encountered a problem with OneToOneMapping and type coercion. When writing > data, thing work; when reading data, the right child of relation fails to > convert. > > I tried everything possible to inject converters (even subclassing > GlorpBlobType), but to no avail. RelationExpression passes conversion to its > left child: > > convertedDbValueOf: anObject > "Assume that our types match, so we can ask either child to do the > conversion. That isn't guaranteed, but should at least work for the common > cases." > ^leftChild convertedDbValueOf: anObject. > > but the left child is FieldExpression in case of OneToOneMapping, which: > > convertedDbValueOf: anObject > "We don't do any conversion" > ^anObject > > What is strange, writing works (even the OneToOneMapping, I opened the > sqlite file with an explorer), but second SELECT, one using the relation > (`state := self dao findStateByAgent: agent` in clientSync), fails with > "GlorpDatabaseReadError: Could not coerce arguments". FWIW, the first one > _does_ convert when creating bindings, as it uses MappingExpression as left > child (stepped over it in debugger). > > > > Is it meant to be a strange case that primary key is something non-primitive > needing coercion (in this case, it is a UUID which needs coercion to > ByteArray, even if it is its subclass)? > > > > Here's the stack of running the test which fails: > > PharoDatabaseAccessor(DatabaseAccessor)>>handleError:for: > [ :ex | self handleError: ex for: command ] in [ | result | > self checkPermissionFor: command. > result := [ (self useBinding and: [ command useBinding ]) > ifTrue: [ command executeBoundIn: self ] > ifFalse: [ command executeUnboundIn: self ] ] > on: Dialect error > do: [ :ex | self handleError: ex for: command ]. > aBoolean > ifTrue: [ result ] > ifFalse: [ result upToEnd ] ] in > PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor: > BlockClosure>>cull: > Context>>evaluateSignal: > Context>>handleSignal: > Error(Exception)>>signal > Error(Exception)>>signal: > ExternalLibraryFunction(Object)>>error: > ExternalLibraryFunction(Object)>>externalCallFailed > ExternalLibraryFunction(ExternalFunction)>>invokeWithArguments: > UDBCSQLite3Library>>apiBindBlob:atColumn:with:with:with: > UDBCSQLite3Library>>with:at:putBlob: > UDBCSQLite3Statement>>at:putByteArray: > UDBCSQLite3ResultSet>>execute:withIndex:withValue: > [ :v | i := self execute: statement withIndex: i withValue: v ] in > UDBCSQLite3ResultSet>>execute:withCollection: > OrderedCollection>>do: > UDBCSQLite3ResultSet>>execute:withCollection: > UDBCSQLite3ResultSet>>execute:with:on: > UDBCSQLite3Connection>>execute:with: > GlorpSQLite3Driver>>basicExecuteSQLString:binding: > PharoDatabaseAccessor>>executeCommandBound: > QuerySelectCommand(DatabaseCommand)>>executeBoundIn: > [ (self useBinding and: [ command useBinding ]) > ifTrue: [ command executeBoundIn: self ] > ifFalse: [ command executeUnboundIn: self ] ] in [ | result | > self checkPermissionFor: command. > result := [ (self useBinding and: [ command useBinding ]) > ifTrue: [ command executeBoundIn: self ] > ifFalse: [ command executeUnboundIn: self ] ] > on: Dialect error > do: [ :ex | self handleError: ex for: command ]. > aBoolean > ifTrue: [ result ] > ifFalse: [ result upToEnd ] ] in > PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor: > BlockClosure>>on:do: > [ | result | > self checkPermissionFor: command. > result := [ (self useBinding and: [ command useBinding ]) > ifTrue: [ command executeBoundIn: self ] > ifFalse: [ command executeUnboundIn: self ] ] > on: Dialect error > do: [ :ex | self handleError: ex for: command ]. > aBoolean > ifTrue: [ result ] > ifFalse: [ result upToEnd ] ] in > PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor: > [ caught := true. > self wait. > blockValue := mutuallyExcludedBlock value ] in Semaphore>>critical: > BlockClosure>>ensure: > Semaphore>>critical: > PharoDatabaseAccessor(DatabaseAccessor)>>executeCommand:returnCursor: > [ session accessor executeCommand: command returnCursor: true ] in > SimpleQuery>>rowsFromDatabaseWithParameters: > BlockClosure>>on:do: > SimpleQuery>>rowsFromDatabaseWithParameters: > SimpleQuery(AbstractReadQuery)>>readFromDatabaseWithParameters: > SimpleQuery(AbstractReadQuery)>>executeWithParameters:in: > GlorpSession>>execute: > GlorpSession>>readOneOf:where: > TowergameDao>>findStateByAgent: > [ | agent state | > agent := self dao findAgentById: anObject agentId. > state := self dao findStateByAgent: agent. > ^ NeoJSONObject new > agentId: agent id; > stateVersion: state version; > totalAnsweredQuestions: > (NeoJSONObject new > good: 0; > bad: 0; > yourself); > yourself ] in Towergame>>clientSync: > [ myUnitOfWork := self hasUnitOfWork not. > myUnitOfWork > ifTrue: [ self beginUnitOfWork ]. > result := aBlock numArgs = 1 > ifTrue: [ aBlock value: self ] > ifFalse: [ aBlock value ]. > myUnitOfWork > ifTrue: [ self commitUnitOfWork ] ] in GlorpSession>>inUnitOfWorkDo: > BlockClosure>>ifCurtailed: > GlorpSession>>inUnitOfWorkDo: > TowergameDao>>inUnitOfWorkDo: > Towergame>>clientSync: > TowergameSyncTests>>testPlayerChecksStateVersion > TowergameSyncTests(TestCase)>>performTest > [ self setUp. > self performTest ] in TowergameSyncTests(TestCase)>>runCase > BlockClosure>>ensure: > TowergameSyncTests(TestCase)>>runCase > [ aTestCase runCase ] in [ [ aTestCase runCase ] > on: Halt > do: [ :halt | > "if test was halted we should resume all background failures > to debug all of them together with test process" > failedProcesses keysDo: #resume. > halt pass ] ] in > TestExecutionEnvironment>>runTestCaseSafelly: > BlockClosure>>on:do: > [ [ aTestCase runCase ] > on: Halt > do: [ :halt | > "if test was halted we should resume all background failures > to debug all of them together with test process" > failedProcesses keysDo: #resume. > halt pass ] ] in > TestExecutionEnvironment>>runTestCaseSafelly: > BlockClosure>>on:do: > TestExecutionEnvironment>>runTestCaseSafelly: > [ self runTestCaseSafelly: aTestCase ] in [ [ self runTestCaseSafelly: > aTestCase ] > ensure: [ testCompleted := true. > watchDogSemaphore signal ]. "signal that test case > completes" > self checkForkedProcesses ] in TestExecutionEnvironment>>runTestCase: > BlockClosure>>ensure: > [ [ self runTestCaseSafelly: aTestCase ] > ensure: [ testCompleted := true. > watchDogSemaphore signal ]. "signal that test case > completes" > self checkForkedProcesses ] in TestExecutionEnvironment>>runTestCase: > BlockClosure>>ifCurtailed: > TestExecutionEnvironment>>runTestCase: > [ testEnv runTestCase: aTestCase ] in > DefaultExecutionEnvironment>>runTestCase: > [ self value: anExecutionEnvironment. > anExecutionEnvironment activated. > aBlock value ] in CurrentExecutionEnvironment class>>activate:for: > BlockClosure>>ensure: > CurrentExecutionEnvironment class>>activate:for: > TestExecutionEnvironment(ExecutionEnvironment)>>beActiveDuring: > DefaultExecutionEnvironment>>runTestCase: > CurrentExecutionEnvironment class>>runTestCase: > TowergameSyncTests(TestCase)>>runCaseManaged > [ aTestCase announce: TestCaseStarted withResult: self. > aTestCase runCaseManaged. > aTestCase announce: TestCaseEnded withResult: self. > self addPass: aTestCase ] in TestResult>>runCaseForDebug: > BlockClosure>>on:do: > TestResult>>runCaseForDebug: > [ result runCaseForDebug: self ] in TowergameSyncTests(TestCase)>>debug > BlockClosure>>ensure: > TowergameSyncTests(TestCase)>>debug > [ :each | > each debug. > self announceTest: each. > self changed: each ] in [ self tests > do: [ :each | > each debug. > self announceTest: each. > self changed: each ] ] in TestSuite>>debug > OrderedCollection>>do: > [ self tests > do: [ :each | > each debug. > self announceTest: each. > self changed: each ] ] in TestSuite>>debug > BlockClosure>>ensure: > TestSuite>>debug > [ :aSuite | aSuite debug ] in TestRunner>>debugSuite: > BlockClosure>>cull: > BlockClosure>>cull:cull: > [ aBlock cull: aTestSuite cull: result ] in TestRunner>>executeSuite:as: > BlockClosure>>ensure: > TestRunner>>executeSuite:as: > TestRunner>>debugSuite: > TestRunner>>debug: > TestRunner>>errorSelected: > PluggableListMorph>>changeModelSelection: > PluggableListMorph>>mouseUpOnSingle: > PluggableListMorph>>mouseUp: > PluggableListMorph(Morph)>>handleMouseUp: > MouseButtonEvent>>sentTo: > PluggableListMorph(Morph)>>handleEvent: > MorphicEventDispatcher>>dispatchDefault:with: > MorphicEventDispatcher>>handleMouseUp: > MouseButtonEvent>>sentTo: > [ ^ anEvent sentTo: self ] in MorphicEventDispatcher>>dispatchEvent:with: > BlockClosure>>ensure: > MorphicEventDispatcher>>dispatchEvent:with: > PluggableListMorph(Morph)>>processEvent:using: > PluggableListMorph(Morph)>>processEvent: > PluggableListMorph>>handleFocusEvent: > [ ActiveHand := self. > ActiveEvent := anEvent. > result := focusHolder > handleFocusEvent: (anEvent transformedBy: (focusHolder > transformedFrom: self)) ] in HandMorph>>sendFocusEvent:to:clear: > BlockClosure>>on:do: > WorldMorph(PasteUpMorph)>>becomeActiveDuring: > HandMorph>>sendFocusEvent:to:clear: > HandMorph>>sendEvent:focus:clear: > HandMorph>>sendMouseEvent: > HandMorph>>handleEvent: > HandMorph>>processEventsFromQueue: > HandMorph>>processEvents > [ :h | > self activeHand: h. > h processEvents. > self activeHand: nil ] in WorldState>>doOneCycleNowFor: > Array(SequenceableCollection)>>do: > WorldState>>handsDo: > WorldState>>doOneCycleNowFor: > WorldState>>doOneCycleFor: > WorldMorph>>doOneCycle > WorldMorph class>>doOneCycle > [ [ WorldMorph doOneCycle. > Processor yield. > false ] whileFalse: [ ] ] in MorphicUIManager>>spawnNewProcess > [ self value. > Processor terminateActive ] in BlockClosure>>newProcess > > > > And here's the code: > > > Towergame.st: > > GlorpBlobType subclass: #GlorpBlob2Type > instanceVariableNames: '' > classVariableNames: '' > poolDictionaries: '' > category: 'Towergame'! > > !GlorpBlob2Type methodsFor: 'types' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > converterForStType: aClass > aClass = UUID ifTrue: [ ^ UuidConverter new ]. > ^ super converterForStType: aClass! ! > > > Object subclass: #TgAct > instanceVariableNames: 'agent tool timestamp' > classVariableNames: '' > poolDictionaries: '' > category: 'Towergame'! > !TgAct commentStamp: 'HerbyVojcik 8/5/2017 19:23' prior: 0! > I represent a relationship between a player (TgAgent) > and a device (TgTool). > > In particular, I am created whenever a player logs in to the game from > different device > than it was last time (or first time, ever).! > > > !TgAct methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 18:09:53'! > agent > ^ agent! ! > > !TgAct methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 18:09:53'! > agent: anObject > agent := anObject! ! > > !TgAct methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 18:09:53'! > timestamp: anObject > timestamp := anObject! ! > > !TgAct methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 18:09:53'! > tool > ^ tool! ! > > !TgAct methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 18:09:53'! > tool: anObject > tool := anObject! ! > > !TgAct methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 18:09:53'! > timestamp > ^ timestamp! ! > > > !TgAct methodsFor: 'initialization' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > initialize > > super initialize. > > agent := nil. > timestamp := DateAndTime now asUTC. > tool := nil.! ! > > "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! > > TgAct class > instanceVariableNames: ''! > > !TgAct class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > agent: aTgAgent tool: aTgTool > ^ self new > agent: aTgAgent; > tool: aTgTool; > yourself! ! > > > Object subclass: #TgAgent > instanceVariableNames: 'id' > classVariableNames: '' > poolDictionaries: '' > category: 'Towergame'! > !TgAgent commentStamp: 'HerbyVojcik 8/5/2017 19:22' prior: 0! > I represent a towergame player. > > I only contain player-related information; > the game state itself is in TgState.! > > > !TgAgent methodsFor: 'initialization' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > initialize > > super initialize. > > id := nil.! ! > > > !TgAgent methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > id: anObject > id := anObject! ! > > !TgAgent methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > id > ^ id! ! > > "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! > > TgAgent class > instanceVariableNames: ''! > > !TgAgent class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > id: aString > ^ self new > id: aString; > yourself! ! > > > Object subclass: #TgAnswers > instanceVariableNames: 'good bad' > classVariableNames: '' > poolDictionaries: '' > category: 'Towergame'! > !TgAnswers commentStamp: 'HerbyVojcik 8/5/2017 20:23' prior: 0! > I represent the answered question stats. > > I know how many good / bad answered questions there is.! > > > !TgAnswers methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > good > ^ good! ! > > !TgAnswers methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > bad: anObject > bad := anObject! ! > > !TgAnswers methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > bad > ^ bad! ! > > !TgAnswers methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > good: anObject > good := anObject! ! > > > !TgAnswers methodsFor: 'initialization' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > initialize > > super initialize. > > bad := 0. > good := 0.! ! > > "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! > > TgAnswers class > instanceVariableNames: ''! > > !TgAnswers class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > good: anInteger bad: anInteger2 > ^ self new > good: anInteger; > bad: anInteger2; > yourself! ! > > > Object subclass: #TgFloors > instanceVariableNames: 'total reinforced' > classVariableNames: '' > poolDictionaries: '' > category: 'Towergame'! > !TgFloors commentStamp: 'HerbyVojcik 8/5/2017 20:22' prior: 0! > I represent the floor building status. > > I know how many floors are build and how many of them is reinforced.! > > > !TgFloors methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > total > ^ total! ! > > !TgFloors methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > total: anObject > total := anObject! ! > > !TgFloors methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > reinforced > ^ reinforced! ! > > !TgFloors methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > reinforced: anObject > reinforced := anObject! ! > > > !TgFloors methodsFor: 'initialization' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > initialize > > super initialize. > > reinforced := 0. > total := 0.! ! > > "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! > > TgFloors class > instanceVariableNames: ''! > > !TgFloors class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > total: anInteger > ^ self total: anInteger reinforced: 0! ! > > !TgFloors class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > total: anInteger reinforced: anInteger2 > ^ self new > total: anInteger; > reinforced: anInteger2; > yourself! ! > > > Object subclass: #TgState > instanceVariableNames: 'agent version packs valuables score > bestScore answers' > classVariableNames: '' > poolDictionaries: '' > category: 'Towergame'! > !TgState commentStamp: 'HerbyVojcik 8/5/2017 20:20' prior: 0! > I represent the game state. > > I have relation to a player (TgAgent) and have a version. > Then, I contain (directly or indirectly) other parts that > make up the player's game state. > > Whenever I am changed by game progress, my version is changed as well.! > > > !TgState methodsFor: 'initialization' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > initialize > > super initialize. > > agent := nil. > answers := nil. > bestScore := nil. > packs := Set new. > score := nil. > valuables := nil. > version := nil.! ! > > > !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > score: anObject > score := anObject! ! > > !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > bestScore: anObject > bestScore := anObject! ! > > !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > agent: anObject > agent := anObject! ! > > !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > score > ^ score! ! > > !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > packs > ^ packs! ! > > !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > version > ^ version! ! > > !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > bestScore > ^ bestScore! ! > > !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > agent > ^ agent! ! > > !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > answers: anObject > answers := anObject! ! > > !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > valuables: anObject > valuables := anObject! ! > > !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > valuables > ^ valuables! ! > > !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > version: anObject > version := anObject! ! > > !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > answers > ^ answers! ! > > !TgState methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > packs: anObject > packs := anObject! ! > > "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! > > TgState class > instanceVariableNames: ''! > > !TgState class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > agent: aTgAgent version: aString > ^ self new > agent: aTgAgent; > version: aString; > yourself! ! > > > Object subclass: #TgTool > instanceVariableNames: 'id' > classVariableNames: '' > poolDictionaries: '' > category: 'Towergame'! > !TgTool commentStamp: 'HerbyVojcik 8/5/2017 19:26' prior: 0! > I represent the device (mobile phone, web browser, ..) > that player uses to connect to game.! > > > !TgTool methodsFor: 'initialization' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > initialize > > super initialize. > > id := nil.! ! > > > !TgTool methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 18:09:53'! > id: anObject > id := anObject! ! > > !TgTool methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 18:09:53'! > id > ^ id! ! > > "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! > > TgTool class > instanceVariableNames: ''! > > !TgTool class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > id: aString > ^ self new > id: aString; > yourself! ! > > > Object subclass: #TgValuables > instanceVariableNames: 'coins gems' > classVariableNames: '' > poolDictionaries: '' > category: 'Towergame'! > !TgValuables commentStamp: 'HerbyVojcik 8/5/2017 20:22' prior: 0! > I represent a purse. > > I know how many coins and gems there is.! > > > !TgValuables methodsFor: 'initialization' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > initialize > > super initialize. > > coins := 0. > gems := 0.! ! > > > !TgValuables methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > gems: anObject > gems := anObject! ! > > !TgValuables methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > coins: anObject > coins := anObject! ! > > !TgValuables methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > gems > ^ gems! ! > > !TgValuables methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > coins > ^ coins! ! > > "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! > > TgValuables class > instanceVariableNames: ''! > > !TgValuables class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > coins: anInteger gems: anInteger2 > ^ self new > coins: anInteger; > gems: anInteger2; > yourself! ! > > > Object subclass: #Towergame > instanceVariableNames: 'dao' > classVariableNames: '' > poolDictionaries: '' > category: 'Towergame'! > !Towergame commentStamp: 'HerbyVojcik 5/17/2017 17:19' prior: 0! > I am the Towergame app class. > > I configure and start towergame server processing.! > > > !Towergame methodsFor: 'actions' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > clientSync: anObject > self dao inUnitOfWorkDo: [ > | agent state | > agent := self dao findAgentById: anObject agentId. > state := self dao findStateByAgent: agent. > ^ NeoJSONObject new > agentId: agent id; > stateVersion: state version; > totalAnsweredQuestions: (NeoJSONObject new good: 0; > bad: 0; yourself); > yourself ]! ! > > > !Towergame methodsFor: 'initialization' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > initialize > > super initialize. > > dao := nil. > ! ! > > > !Towergame methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > dao: anObject > dao := anObject! ! > > !Towergame methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > dao > ^ dao! ! > > "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! > > Towergame class > instanceVariableNames: 'default'! > > !Towergame class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > dao: aDao > ^ self new > dao: aDao; > yourself! ! > > > !Towergame class methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > defaultDbLogin > | databaseFile | > databaseFile := Smalltalk imageDirectory asFileReference / > 'towergame.db'. > ^ Login new > database: UDBCSQLite3Platform new; > host: ''; > port: ''; > username: ''; > password: ''; > databaseName: databaseFile fullPath asZnUrl > asString; > yourself ! ! > > !Towergame class methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > default > ^ default ifNil: [ default := self > dao: (self daoForLogin: self defaultDbLogin) > ]! ! > > !Towergame class methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > defaultPort > ^ 4998! ! > > > !Towergame class methodsFor: 'configuration' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > configureServer > (self serverFor: self default on: self defaultPort) start; register > ! ! > > !Towergame class methodsFor: 'configuration' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > configureSqlite3 > > PharoDatabaseAccessor DefaultDriver: GlorpSQLite3Driver! ! > > !Towergame class methodsFor: 'configuration' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > configure > self configureSqlite3. > self configureServer.! ! > > > !Towergame class methodsFor: 'factory' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > daoForLogin: aLogin > ^ TowergameDao forLogin: aLogin! ! > > !Towergame class methodsFor: 'factory' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > serverFor: aTowergame on: port > ^ (ZnServer on: port) > delegate: (TowergameDelegate on: aTowergame); > yourself! ! > > > Object subclass: #TowergameDao > instanceVariableNames: 'glorpSession glorpLogin' > classVariableNames: '' > poolDictionaries: '' > category: 'Towergame'! > > !TowergameDao methodsFor: 'transactions' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > inUnitOfWorkDo: aBlock > ^ self glorpSession inUnitOfWorkDo: aBlock! ! > > > !TowergameDao methodsFor: 'initialization' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > initialize > > super initialize. > > glorpLogin := nil. > glorpSession := nil.! ! > > > !TowergameDao methodsFor: 'initialize-release' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > reset > glorpSession := nil.! ! > > > !TowergameDao methodsFor: 'query' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > findStateByAgent: anAgent > ^ self glorpSession readOneOf: TgState where: [ :one | one agent = > anAgent ]! ! > > !TowergameDao methodsFor: 'query' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > findAgentById: anUUID > ^ self glorpSession readOneOf: TgAgent where: [ :one | one id = > anUUID ]! ! > > > !TowergameDao methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > glorpLogin: anObject > glorpLogin := anObject! ! > > !TowergameDao methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > glorpLogin > ^ glorpLogin! ! > > !TowergameDao methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > glorpSession > glorpSession ifNil: [ > glorpSession := TowergameDescriptorSystem sessionForLogin: > self glorpLogin ]. > glorpSession accessor isLoggedIn ifFalse: [ > glorpSession accessor login ]. > ^ glorpSession! ! > > "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! > > TowergameDao class > instanceVariableNames: ''! > > !TowergameDao class methodsFor: 'instance creation' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > forLogin: aLogin > ^ self new > glorpLogin: aLogin; > yourself! ! > > > ZnDispatcherDelegate subclass: #TowergameDelegate > instanceVariableNames: 'towergame' > classVariableNames: '' > poolDictionaries: '' > category: 'Towergame'! > > !TowergameDelegate methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > towergame > ^ towergame! ! > > !TowergameDelegate methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > towergame: anObject > towergame := anObject! ! > > > !TowergameDelegate methodsFor: 'initialization' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > initialize > super initialize. > towergame := nil. > self > map: '/api/v1/sync' > to: [ :request :response | self syncRequest: request > toResponse: response ]! ! > > > !TowergameDelegate methodsFor: 'action' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > syncRequest: request toResponse: response > | requestPayload responsePayload uuidKeys | > uuidKeys := #(agentId stateVersion deviceId). > request method == #POST ifFalse: [ ^ ZnResponse methodNotAllowed: > request ]. > requestPayload := NeoJSONObject fromString: request contents. > requestPayload ifNotNil: [ > uuidKeys do: [ :each | requestPayload at: each ifPresentPut: > [ :s | UUID fromString: s ] ] ]. > responsePayload := self towergame clientSync: requestPayload. > responsePayload ifNotNil: [ > uuidKeys do: [ :each | responsePayload at: each > ifPresentPut: #asString ] ]. > ^ response > entity: (ZnEntity > with: (NeoJSONWriter toString: responsePayload) > type: ZnMimeType applicationJson); > yourself! ! > > "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! > > TowergameDelegate class > instanceVariableNames: ''! > > !TowergameDelegate class methodsFor: 'instance creation' stamp: 'HerbertVojÄ > Ãk 8/14/2017 18:09:53'! > on: aTowergame > ^ self new towergame: aTowergame; yourself! ! > > > DescriptorSystem subclass: #TowergameDescriptorSystem > instanceVariableNames: 'uuidConverter' > classVariableNames: '' > poolDictionaries: '' > category: 'Towergame'! > > !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > tableForAGENT: aTable > > (aTable createFieldNamed: 'id' type: platform blob2) bePrimaryKey. > ! ! > > !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > classModelForTgAgent: aClassModel > aClassModel > newAttributeNamed: #id type: UUID! ! > > !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbyVojcik 8/14/2017 > 18:24'! > tableForSTATE: aTable > > (aTable createFieldNamed: 'agent' type: platform blob2) in: [ > :agentField | > agentField bePrimaryKey. > aTable addForeignKeyFrom: agentField to: ((self tableNamed: > 'AGENT') fieldNamed: 'id') ]. > (aTable createFieldNamed: 'version' type: platform blob) beIndexed. > ! ! > > !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > descriptorForTgAgent: aDescriptor > | table | > table := self tableNamed: 'AGENT'. > aDescriptor table: table. > (aDescriptor newMapping: DirectMapping) > from: #id to: (table fieldNamed: 'id').! ! > > !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > tableForACT: aTable > > (aTable createFieldNamed: 'agent' type: platform blob2) beIndexed. > (aTable createFieldNamed: 'tool' type: platform blob2) beIndexed. > (aTable createFieldNamed: 'timestamp' type: platform timestamp) > beIndexed. > ! ! > > !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > descriptorForTgState: aDescriptor > | table | > table := self tableNamed: 'STATE'. > aDescriptor table: table. > (aDescriptor newMapping: OneToOneMapping) attributeName: #agent. > (aDescriptor newMapping: DirectMapping) > from: #version to: (table fieldNamed: 'version').! ! > > !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > converterBetweenStType: aClass andField: aField > (aClass = UUID and: [ aField impliedSmalltalkType = ByteArray]) > ifTrue: [ ^ self uuidConverter ]. > ^ super converterBetweenStType: aClass andField: aField! ! > > !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > classModelForTgState: aClassModel > "agent version packs valuables score bestScore answers" > aClassModel > newAttributeNamed: #agent type: TgAgent; > newAttributeNamed: #version type: UUID! ! > > !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > classModelForTgTool: aClassModel > aClassModel > newAttributeNamed: #id > ! ! > > !TowergameDescriptorSystem methodsFor: 'glorp' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > classModelForTgAct: aClassModel > aClassModel > newAttributeNamed: #timestamp; > newAttributeNamed: #agent type: TgAgent; > newAttributeNamed: #tool type: TgTool! ! > > > !TowergameDescriptorSystem methodsFor: 'accessing' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > uuidConverter > ^ uuidConverter ifNil: [ uuidConverter := UuidConverter new name: > 'uuid'; yourself ]! ! > > > DatabaseConverter subclass: #UuidConverter > instanceVariableNames: '' > classVariableNames: '' > poolDictionaries: '' > category: 'Towergame'! > > !UuidConverter methodsFor: 'converting' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > convert: anObject toDatabaseRepresentationAs: aDatabaseType > ^ anObject ifNotNil: [ ByteArray withAll: anObject ]! ! > > !UuidConverter methodsFor: 'converting' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > convert: anObject fromDatabaseRepresentationAs: aDatabaseType > ^ anObject ifNotNil: [ UUID withAll: anObject ]! ! > 'From Pharo6.0 of 13 May 2016 [Latest update: #60510] on 14 August 2017 at > 6:26:30.67905 pm'! > > !DatabasePlatform methodsFor: '*Towergame' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > blob2 > ^self typeNamed: #blob ifAbsentPut: [GlorpBlob2Type new].! ! > 'From Pharo6.0 of 13 May 2016 [Latest update: #60510] on 14 August 2017 at > 6:26:30.68005 pm'! > > !Dictionary methodsFor: '*Towergame' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > at: key ifPresentPut: aBlock > "Lookup the given key in the receiver. If it is present, update it > with the value of evaluating the given block with the value associated > with the key. Otherwise, answer nil." > > ^ self at: key ifPresent: [ :value | self at: key put: (aBlock cull: > value) ]! ! > > > > > TowergameTests.st: > > TestCase subclass: #TowergameServerTests > instanceVariableNames: 'randomPort towergame server' > classVariableNames: '' > poolDictionaries: '' > category: 'Towergame-Tests'! > > !TowergameServerTests methodsFor: 'running' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > uidy: aString > ^ UUID fromString36: aString ! ! > > !TowergameServerTests methodsFor: 'running' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > setUp > randomPort := 1700 + 32 atRandom. > towergame := Mock new. > server := Towergame serverFor: towergame on: randomPort. > server start. > self > assert: server isRunning & server isListening > description: ('Failed to start server on port {1}. Is there > one already?' format: { server port }) > ! ! > > !TowergameServerTests methodsFor: 'running' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > tearDown > server stop! ! > > > !TowergameServerTests methodsFor: 'tests' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > testEmptySyncRequest > | znClient response | > (towergame stub clientSync: Arg payload) willReturn: nil. > znClient := self znClientForSync: 'null'. > response := znClient timeout: 1; post; response. > response should satisfy: #isSuccess. > response contentType should equal: ZnMimeType applicationJson. > (STON fromString: response entity contents) should equal: nil. > Arg payload should equal: nil! ! > > !TowergameServerTests methodsFor: 'tests' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > testRejectEmptyGetSyncRequest > | znClient response | > (towergame stub clientSync: Arg payload) willReturn: nil. > znClient := self znClientForSync: 'null'. > response := znClient timeout: 1; get; response. > response code should equal: ZnStatusLine methodNotAllowed code. > towergame should not receive clientSync: Any! ! > > !TowergameServerTests methodsFor: 'tests' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > testNonEmptySyncRequest > | znClient response | > (towergame stub clientSync: Arg payload) willReturn: { #agentId -> > (self uidy: '007') } asDictionary. > znClient := self znClientForSync: > > ('\{"deviceId":"{1}","agentAnsweredQuestions":\{"good":1,"bad":2\}\}' > format: { self uidy: 'Q' }). > response := znClient timeout: 1; post; response. > response should satisfy: #isSuccess. > response contentType should equal: ZnMimeType applicationJson. > (STON fromString: response entity contents) should equal: { > 'agentId' -> (self uidy: '007') asString } asDictionary. > Arg payload in: [ :arg | > arg deviceId should equal: (self uidy: 'Q'). > arg agentAnsweredQuestions should satisfy: #notNil. > arg agentAnsweredQuestions good should equal: 1. > arg agentAnsweredQuestions bad should equal: 2 ] > ! ! > > > !TowergameServerTests methodsFor: 'private' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > znClientForSync: jsonString > ^ ZnClient new > url: server localUrl; > path: '/api/v1/sync'; > entity: > (ZnEntity > with: jsonString > type: ZnMimeType applicationJson) > ! ! > > > TestCase subclass: #TowergameSyncTests > instanceVariableNames: 'towergame session dao' > classVariableNames: '' > poolDictionaries: '' > category: 'Towergame-Tests'! > > !TowergameSyncTests methodsFor: 'tests' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > testPlayerChecksStateVersionAndIsBehind > | result payload | > session createTables. > session inUnitOfWorkDo: [ > | agent state | > agent := TgAgent id: (self uidy: '007'). > state := (TgState agent: agent version: (self uidy: > '18-eff')) > packs: #('foopack' 'barpack') asSet; > valuables: (TgValuables coins: 20 gems: 3); > score: (TgFloors total: 4 reinforced: 1); > bestScore: (TgFloors total: 18); > answers: (TgAnswers good: 2 bad: 3); > yourself. > session registerAll: {state. TgAct agent: agent tool: > (TgTool id: (self uidy: 'Q7') ) } ]. > towergame := Towergame dao: dao. > payload := NeoJSONObject new > agentId: (self uidy: '007'); stateVersion: (self uidy: > '23-fefe'); deviceId: (self uidy: 'Q7'). > result := towergame clientSync: payload. > result where agentId should equal: (self uidy: '007'). > result where stateVersion should equal: (self uidy: '18-eff'). > result where purchasedPacks should satisfy: [ :x | x asSet should > equal: #('foopack' 'barpack') asSet ]. > result where valuables coins should equal: 20. > result where valuables gems should equal: 3. > result where floorsNumber current should equal: 4. > result where floorsNumber best should equal: 18. > result where floorsNumber reinforced should equal: 1. > result where agentAnsweredQuestions good should equal: 2. > result where agentAnsweredQuestions bad should equal: 3. > result where totalAnsweredQuestions good should equal: 2. > result where totalAnsweredQuestions bad should equal: 3! ! > > !TowergameSyncTests methodsFor: 'tests' stamp: 'HerbyVojcik 8/14/2017 > 18:18'! > testPlayerChecksStateVersion > | result payload | > session createTables. > session inUnitOfWorkDo: [ > | agent state | > agent := TgAgent id: (self uidy: '007'). > state := TgState agent: agent version: (self uidy: > '23-fefe'). > session registerAll: {state. TgAct agent: agent tool: > (TgTool id: (self uidy: 'Q7') ) } ]. > towergame := Towergame dao: dao. > payload := NeoJSONObject new > agentId: (self uidy: '007'); stateVersion: (self uidy: > '23-fefe'); deviceId: (self uidy: 'Q7'). > result := towergame clientSync: payload. > result where agentId should equal: (self uidy: '007'). > result where stateVersion should equal: (self uidy: '23-fefe'). > result where totalAnsweredQuestions good should equal: 0. > result where totalAnsweredQuestions bad should equal: 0! ! > > > !TowergameSyncTests methodsFor: 'running' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > uidy: aString > ^ UUID fromString36: aString ! ! > > !TowergameSyncTests methodsFor: 'running' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > setUp > dao := Towergame daoForLogin: self loginToTemporaryDatabase. > session := dao glorpSession. > ! ! > > !TowergameSyncTests methodsFor: 'running' stamp: 'HerbertVojÄ Ãk 8/14/2017 > 18:09:53'! > tearDown > session logout! ! > > !TowergameSyncTests methodsFor: 'running' stamp: 'HerbyVojcik 8/14/2017 > 18:16'! > loginToTemporaryDatabase > ^ Login new > database: UDBCSQLite3Platform new; > host: ''; > port: ''; > username: ''; > password: ''; > databaseName: ''; > yourself! ! > > > > > > BaselineOfTowergame.st: > BaselineOf subclass: #BaselineOfTowergame > instanceVariableNames: '' > classVariableNames: '' > poolDictionaries: '' > category: 'BaselineOfTowergame'! > > !BaselineOfTowergame methodsFor: 'baseline' stamp: 'HerbertVojÄ Ãk > 8/14/2017 18:09:53'! > baseline: spec > <baseline> > spec for: #common do: [ spec > > package: 'Towergame' with: [ spec > requires: #('GlorpSQLite' 'NeoJSON') ]; > package: 'Towergame-Tests' with: [ spec > requires: #('Towergame' 'Mocketry') ]; > > configuration: 'GlorpSQLite' with: [ spec > version: #stable; > repository: > 'http://smalltalkhub.com/mc/Pharo/MetaRepoForPharo60/main' ]; > configuration: 'NeoJSON' with: [ spec > version: #stable; > repository: > 'http://smalltalkhub.com/mc/Pharo/MetaRepoForPharo60/main' ]; > baseline: 'Mocketry' with: [ spec > repository: 'github://dionisiydk/Mocketry:v4.0.x' ]; > > group: 'default' with: #('Core'); > group: 'development' with: #('Core' 'Tests'); > group: 'Core' with: #('Towergame'); > group: 'Tests' with: #('Towergame-Tests') ] > ! ! > >
